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