tb-list.pl

   1 #!/usr/bin/perl
   2 # usage: tb-list [<patch-spec>]
   3 #  lists all patches matching <patch-spec> and other criteria
   4
   5 xxx needs updating for new metadata and new theory
   6
   7 use warnings;
   8 use strict;
   9
  10 use Getopt::Long;
  11 use Topbloke;
  12
  13 #----- option parsing -----
  14
  15 Getopt::Long::Configure(qw(bundling));
  16
  17 our $deleted=0;
  18 our $deleted_only=0;
  19 our $current=0;
  20 our $relatedto;
  21 our $leaves=0;
  22 our $sort='';
  23
  24 GetOptions("d|deleted!" => \$deleted,         # including deleted patches
  25            "deleted-only!" => \$deleted_only, # only deleted patches
  26            "r|related=s" => sub {             # only patches related to that
  27                $relatedto = parse_patch_spec($_[1]);
  28            },
  29            "c|related-current" => sub {      # only patches related to current
  30                my $current_branch = current_branch();
  31                die "-c only permitted when on a topbloke branch\n"
  32                    unless $current_branch->{Kind} =~ m/^(?:tip|base)$/;
  33                $relatedto = $current_branch;
  34            },
  35            "l|last|leaf|leaves" => \$leaves, # only leaf patches
  36            "sort=s" => \$sort,
  37     ) or die "bad options\n";
  38
  39 our $spec;
  40
  41 if (@ARGV==1) {
  42     $spec = parse_patch_spec($ARGV[0]);
  43 } elsif (!@ARGV) {
  44 } else {
  45     die "too many arguments\n";
  46 }
  47
  48 our @sort = grep { /./ } split m/,/, $sort;
  49 push @sort, 'topo' if !$spec;
  50 push @sort, 'created';
  51 my $toposort = 0;
  52 foreach $sort (@sort) {
  53     die "bad sort $sort\n" unless grep { $_ eq $sort }
  54         qw(fullname created nick topo);
  55     $toposort=1 if $sort eq $toposort;
  56 }
  57
  58 #----- list patches -----
  59
  60 our %patches;
  61
  62 foreach_patch($relatedto || $leaves || !$spec ? { } : $spec,
  63 xxx new api for foreach_patch
  64               $deleted || $deleted_only,
  65               [0, !!$leaves, 0, $toposort || !!$relatedto],
  66               sub {
  67                   my ($patch,$parsedname,@info) = @_;
  68                   $patches{$patch}{Info} = \@info;
  69                   $patches{$patch}{ParsedName} = $parsedname;
  70               });
  71
  72 #----- selection -----
  73
  74 if ($leaves) {
  75     debug("leaves");
  76     foreach my $p (keys %patches) {
  77         debug("leaves $p");
  78         my $v = $patches{$p};
  79         next if $v->{Info}[0]{Deleted};
  80         foreach my $dep (keys %{ $v->{Info}[1] }) {
  81             debug("leaves $p $dep");
  82             next unless exists $patches{$dep};
  83             $patches{$dep}{NotLeaf} = 1;
  84         }
  85     }
  86 }
  87
  88 if ($relatedto) {
  89     foreach my $p (keys %patches) {
  90         my $v = $patches{$p};
  91         # mark Related=1 if any patch matching $relatedto includes us
  92         foreach my $dep (keys %{ $v->{Info}[3] }) {
  93             next unless exists $patches{$dep};
  94             my $depv = $patches{$dep};
  95             next unless patch_matches_spec($depv->{ParsedName}, $relatedto);
  96             $v->{Related} = 1;
  97             last;
  98         }
  99         if (patch_matches_spec($v->{ParsedName}, $relatedto)) {
 100             # if we match $relatedto, mark all our inclusions as Related=1
 101             foreach my $dep (keys %{ $v->{Info}[3] }) {
 102                 next unless exists $patches{$dep};
 103                 $patches{$dep}{Related} = 1;
 104             }
 105             # oh, and mark ourselves as Related=1 too!
 106             $v->{Related} = 1;
 107         }
 108     }
 109 }
 110
 111 our @output;
 112
 113 foreach my $p (keys %patches) {
 114     my $v = $patches{$p};
 115     next if !$deleted && $v->{Info}[0]{Deleted};
 116     next if $deleted_only && !$v->{Info}[0]{Deleted};
 117     next if $leaves && $v->{NotLeaf};
 118     next if $relatedto && !$v->{Related};
 119     next if $spec && !patch_matches_spec($v->{ParsedName}, $spec);
 120     push @output, $p;
 121 }
 122
 123 #----- sorting -----
 124
 125 sub sortsub () {
 126     my $txt = "sub sort_cmp {\n    my \$r;\n";
 127     debug("@sort");
 128     my $def_vab;
 129     $def_vab = sub {
 130         foreach my $ab (qw(a b)) {
 131             $txt .= "    my \$v$ab = \$patches{\$$ab};\n";
 132         }
 133         $def_vab = sub { };
 134     };
 135     my $by_r = sub {
 136         $txt .= "    \$r = $_[0];\n    return \$r if \$r;\n";
 137     };
 138     my $by_parsed = sub {
 139         $def_vab->();
 140         $by_r->("\$va->{ParsedName}{$_[0]} cmp \$vb->{ParsedName}{$_[0]}");
 141     };
 142     my %done;
 143     foreach my $sort (@sort) {
 144         next if $done{$sort}++;
 145         if ($sort eq 'fullname') {
 146             $by_r->('$a cmp $b');
 147         } elsif ($sort eq 'created') {
 148             $by_parsed->('Date');
 149         } elsif ($sort eq 'nick') {
 150             $by_parsed->('Nick');
 151         } elsif ($sort eq 'topo') {
 152             $def_vab->();
 153             foreach my $ix (qw(0 1)) {
 154                 my $ab = (qw(a b))[$ix];
 155                 my $ba = (qw(b a))[$ix];
 156                 my $r = (qw(1 -1))[$ix];
 157                 $txt .= "    return $r if \$v${ab}->{Info}[3]{\$$ba};\n";
 158             }
 159         } else {
 160             die $sort;
 161         }
 162     }
 163     $txt .= "    return 0;\n}\n";
 164     debug("sortsub | $_") foreach split /\n/, $txt;
 165     return $txt;
 166 }
 167 eval sortsub()." 1;" or die "$@ ?";
 168
 169 @output = sort sort_cmp @output;
 170
 171 #----- printing -----
 172
 173 my $current_branch = current_branch();
 174 my $current_patch = '';
 175 my $ifcurrent;
 176 if ($current_branch->{Kind} eq 'tip') {
 177     $current_patch = $current_branch->{Fullname};
 178     $ifcurrent = '>';
 179 } elsif ($current_branch->{Kind} eq 'base') {
 180     $current_patch = $current_branch->{Fullname};
 181     $ifcurrent = '#';
 182 }
 183
 184 foreach my $p (@output) {
 185     my $v = $patches{$p};
 186     my $pa = $v->{ParsedName};
 187     my ($msgkind, $msg) = git_get_object("$pa->{Ref}:.topbloke/msg");
 188     die "$p $msgkind ?" unless $msgkind eq 'blob';
 189     my $subject =
 190         $msg =~ m/^Subject:\s*(?:\[[^][]*\]\s*)?(.*\S)\s*$/mi
 191         ? $1 : "[no subject]";
 192     printf("%1s%1s %s\@%s/%s/%-20s %s\n",
 193            $p eq $current_patch ? $ifcurrent : '',
 194            $v->{Info}[0]{Deleted} ? 'D' : '',
 195            $pa->{Email}, $pa->{Domain}, $pa->{Date}, $pa->{Nick},
 196            $subject)
 197         or die $!;
 198 }
 199
 200 closeout();