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