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