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               [0, !!$leaves, 0, $toposort || !!$relatedto],
  63               sub {
  64                   my ($patch,$parsedname,@info) = @_;
  65                   $patches{$patch}{Info} = \@info;
  66                   $patches{$patch}{ParsedName} = $parsedname;
  67               });
  68
  69 #----- selection -----
  70
  71 if ($leaves) {
  72     debug("leaves");
  73     foreach my $p (keys %patches) {
  74         debug("leaves $p");
  75         my $v = $patches{$p};
  76         next if $v->{Info}[0]{Deleted};
  77         foreach my $dep (keys %{ $v->{Info}[1] }) {
  78             debug("leaves $p $dep");
  79             next unless exists $patches{$dep};
  80             $patches{$dep}{NotLeaf} = 1;
  81         }
  82     }
  83 }
  84
  85 if ($relatedto) {
  86     foreach my $p (keys %patches) {
  87         my $v = $patches{$p};
  88         # mark Related=1 if any patch matching $relatedto includes us
  89         foreach my $dep (keys %{ $v->{Info}[3] }) {
  90             next unless exists $patches{$dep};
  91             my $depv = $patches{$dep};
  92             next unless patch_matches_spec($depv->{ParsedName}, $relatedto);
  93             $v->{Related} = 1;
  94             last;
  95         }
  96         if (patch_matches_spec($v->{ParsedName}, $relatedto)) {
  97             # if we match $relatedto, mark all our inclusions as Related=1
  98             foreach my $dep (keys %{ $v->{Info}[3] }) {
  99                 next unless exists $patches{$dep};
 100                 $patches{$dep}{Related} = 1;
 101             }
 102             # oh, and mark ourselves as Related=1 too!
 103             $v->{Related} = 1;
 104         }
 105     }
 106 }
 107
 108 our @output;
 109
 110 foreach my $p (keys %patches) {
 111     my $v = $patches{$p};
 112     next if !$deleted && $v->{Info}[0]{Deleted};
 113     next if $deleted_only && !$v->{Info}[0]{Deleted};
 114     next if $leaves && $v->{NotLeaf};
 115     next if $relatedto && !$v->{Related};
 116     next if $spec && !patch_matches_spec($v->{ParsedName}, $spec);
 117     push @output, $p;
 118 }
 119
 120 #----- sorting -----
 121
 122 sub sortsub () {
 123     my $txt = "sub sort_cmp {\n    my \$r;\n";
 124     debug("@sort");
 125     my $def_vab;
 126     $def_vab = sub {
 127         foreach my $ab (qw(a b)) {
 128             $txt .= "    my \$v$ab = \$patches{\$$ab};\n";
 129         }
 130         $def_vab = sub { };
 131     };
 132     my $by_r = sub {
 133         $txt .= "    \$r = $_[0];\n    return \$r if \$r;\n";
 134     };
 135     my $by_parsed = sub {
 136         $def_vab->();
 137         $by_r->("\$va->{ParsedName}{$_[0]} cmp \$vb->{ParsedName}{$_[0]}");
 138     };
 139     my %done;
 140     foreach my $sort (@sort) {
 141         next if $done{$sort}++;
 142         if ($sort eq 'fullname') {
 143             $by_r->('$a cmp $b');
 144         } elsif ($sort eq 'created') {
 145             $by_parsed->('Date');
 146         } elsif ($sort eq 'nick') {
 147             $by_parsed->('Nick');
 148         } elsif ($sort eq 'topo') {
 149             $def_vab->();
 150             foreach my $ix (qw(0 1)) {
 151                 my $ab = (qw(a b))[$ix];
 152                 my $ba = (qw(b a))[$ix];
 153                 my $r = (qw(1 -1))[$ix];
 154                 $txt .= "    return $r if \$v${ab}->{Info}[3]{\$$ba};\n";
 155             }
 156         } else {
 157             die $sort;
 158         }
 159     }
 160     $txt .= "    return 0;\n}\n";
 161     debug("sortsub | $_") foreach split /\n/, $txt;
 162     return $txt;
 163 }
 164 eval sortsub()." 1;" or die "$@ ?";
 165
 166 @output = sort sort_cmp @output;
 167
 168 #----- printing -----
 169
 170 my $current_branch = current_branch();
 171 my $current_patch = '';
 172 my $ifcurrent;
 173 if ($current_branch->{Kind} eq 'tip') {
 174     $current_patch = $current_branch->{Fullname};
 175     $ifcurrent = '>';
 176 } elsif ($current_branch->{Kind} eq 'base') {
 177     $current_patch = $current_branch->{Fullname};
 178     $ifcurrent = '#';
 179 }
 180
 181 foreach my $p (@output) {
 182     my $v = $patches{$p};
 183     my $pa = $v->{ParsedName};
 184     my ($msgkind, $msg) = git_get_object("$pa->{Ref}:.topbloke/msg");
 185     die "$p $msgkind ?" unless $msgkind eq 'blob';
 186     my $subject =
 187         $msg =~ m/^Subject:\s*(?:\[[^][]*\]\s*)?(.*\S)\s*$/mi
 188         ? $1 : "[no subject]";
 189     printf("%1s%1s %s\@%s/%s/%-20s %s\n",
 190            $p eq $current_patch ? $ifcurrent : '',
 191            $v->{Info}[0]{Deleted} ? 'D' : '',
 192            $pa->{Email}, $pa->{Domain}, $pa->{Date}, $pa->{Nick},
 193            $subject)
 194         or die $!;
 195 }
 196
 197 closeout();