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