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