remove spurious debug; fixes

[topbloke.git] / tb-list.pl

diff --git a/tb-list.pl b/tb-list.pl
index 6be99afd41cc10d4a157ca592e8f3a8677be2d7f..c23f6a00e58d394fd4604065e36d08b7195ed08e 100755 (executable)
--- a/tb-list.pl
+++ b/tb-list.pl
@@ -8,18 +8,28 @@ use strict;
 use Getopt::Long;
 use Topbloke;
 
 use Getopt::Long;
 use Topbloke;
 

+#----- option parsing -----
+

 Getopt::Long::Configure(qw(bundling));
 
 our $deleted=0;
 our $deleted_only=0;
 our $current=0;
 Getopt::Long::Configure(qw(bundling));
 
 our $deleted=0;
 our $deleted_only=0;
 our $current=0;

-our $related=0;
+our $relatedto;

 our $leaves=0;
 our $sort='';
 
 GetOptions("d|deleted!" => \$deleted,         # including deleted patches
           "deleted-only!" => \$deleted_only, # only deleted patches
 our $leaves=0;
 our $sort='';
 
 GetOptions("d|deleted!" => \$deleted,         # including deleted patches
           "deleted-only!" => \$deleted_only, # only deleted patches

-          "r|related=s" => \$related,       # only patches related to this one
+          "r|related=s" => sub {             # only patches related to that
+              $relatedto = parse_patch_spec($_[1]);
+          },
+          "c|related-current" => sub {      # only patches related to current
+              my $current_branch = current_branch();
+              die "-c only permitted when on a topbloke branch\n"
+                  unless $current_branch->{Kind} =~ m/^(?:tip|base)$/;
+              $relatedto = $current_branch;
+          },

           "l|last|leaf|leaves" => \$leaves, # only leaf patches
           "sort=s" => \$sort,
     ) or die "bad options\n";
           "l|last|leaf|leaves" => \$leaves, # only leaf patches
           "sort=s" => \$sort,
     ) or die "bad options\n";


@@ -34,14 +44,162 @@ if (@ARGV==1) {
 }
 
 our @sort = grep { /./ } split m/,/, $sort;
 }
 
 our @sort = grep { /./ } split m/,/, $sort;

-push @sort, $spec ? 'created' : 'topo';
+push @sort, 'topo' if !$spec;
+push @sort, 'created';
+my $toposort = 0;

 foreach $sort (@sort) {
     die "bad sort $sort\n" unless grep { $_ eq $sort } 
         qw(fullname created nick topo);
 foreach $sort (@sort) {
     die "bad sort $sort\n" unless grep { $_ eq $sort } 
         qw(fullname created nick topo);

+    $toposort=1 if $sort eq $toposort;

 }
 
 }
 

-use Data::Dumper;
+#----- list patches -----
+
+our %patches;

 
 

-foreach_patch($spec, $deleted || $deleted_only, [], sub {
-    print Dumper(\@_);
+foreach_patch($relatedto || $leaves || !$spec ? { } : $spec, 
+             $deleted || $deleted_only, 
+             [qw(B_deps +included)],
+             sub { 
+                 my ($patch,$parsedname,$meta) = @_;
+                 $patches{$patch}{Meta} = $meta;
+                 $patches{$patch}{ParsedName} = $parsedname;
+                 $patches{$patch}{Deps} =
+                     grep { m/^[^-]/ } split /\n/, $meta->{'B_deps'};
+                 $patches{$patch}{Included} = { };
+                 $patches{$patch}{Included}{$_} = 1
+                     foreach split /\n/, $meta->{'+included'};

              });
              });

+
+#----- selection -----
+
+if ($leaves) {
+    debug("leaves");
+    foreach my $p (keys %patches) {
+       debug("leaves $p");
+       my $v = $patches{$p};
+       next if defined $v->{Meta}{'deleted'};
+       foreach my $dep (@{ $v->{Deps} }) {
+           debug("leaves $p $dep");
+           next unless exists $patches{$dep};
+           $patches{$dep}{NotLeaf} = 1;
+       }
+    }
+}
+
+if ($relatedto) {
+    foreach my $p (keys %patches) {
+       my $v = $patches{$p};
+       # mark Related=1 if any patch matching $relatedto includes us
+       foreach my $dep (keys %{ $v->{Included} }) {
+           next unless exists $patches{$dep};
+           my $depv = $patches{$dep};
+           next unless patch_matches_spec($depv->{ParsedName}, $relatedto);
+           $v->{Related} = 1;
+           last;
+       }
+       if (patch_matches_spec($v->{ParsedName}, $relatedto)) {
+           # if we match $relatedto, mark all our inclusions as Related=1
+           foreach my $dep (keys %{ $v->{Included} }) {
+               next unless exists $patches{$dep};
+               $patches{$dep}{Related} = 1;
+           }
+           # oh, and mark ourselves as Related=1 too!
+           $v->{Related} = 1;
+       }
+    }
+}
+
+our @output;
+
+foreach my $p (keys %patches) {
+    my $v = $patches{$p};
+    next if !$deleted && defined $v->{Meta}{'deleted'};
+    next if $deleted_only && !defined $v->{Meta}{'deleted'};
+    next if $leaves && $v->{NotLeaf};
+    next if $relatedto && !$v->{Related};
+    next if $spec && !patch_matches_spec($v->{ParsedName}, $spec);
+    push @output, $p;
+}
+
+#----- sorting -----
+
+sub sortsub () {
+    my $txt = "sub sort_cmp {\n    my \$r;\n";
+    debug("@sort");
+    my $def_vab;
+    $def_vab = sub {
+       foreach my $ab (qw(a b)) {
+           $txt .= "    my \$v$ab = \$patches{\$$ab};\n";
+       }
+       $def_vab = sub { };
+    };
+    my $by_r = sub {
+       $txt .= "    \$r = $_[0];\n    return \$r if \$r;\n";
+    };
+    my $by_parsed = sub {
+       $def_vab->();
+       $by_r->("\$va->{ParsedName}{$_[0]} cmp \$vb->{ParsedName}{$_[0]}");
+    };
+    my %done;
+    foreach my $sort (@sort) {
+       next if $done{$sort}++;
+       if ($sort eq 'fullname') {
+           $by_r->('$a cmp $b');
+       } elsif ($sort eq 'created') {
+           $by_parsed->('Date');
+       } elsif ($sort eq 'nick') {
+           $by_parsed->('Nick');
+       } elsif ($sort eq 'topo') {
+           $def_vab->();
+           foreach my $ix (qw(0 1)) {
+               my $ab = (qw(a b))[$ix];
+               my $ba = (qw(b a))[$ix];
+               my $r = (qw(1 -1))[$ix];
+               $txt .= "    return $r if \$v${ab}->{Included}{\$$ba};\n";
+           }
+        } else {
+           die $sort;
+       }
+    }
+    $txt .= "    return 0;\n}\n";
+    debug("sortsub | $_") foreach split /\n/, $txt;
+    return $txt;
+}
+eval sortsub()." 1;" or die "$@ ?";
+
+@output = sort sort_cmp @output;
+
+#----- printing -----
+
+my $current_branch = current_branch();
+my $current_patch = '';
+my $ifcurrent;
+if ($current_branch->{Kind} eq 'tip') {
+    $current_patch = $current_branch->{Fullname};
+    $ifcurrent = '>';
+} elsif ($current_branch->{Kind} eq 'base') {
+    $current_patch = $current_branch->{Fullname};
+    $ifcurrent = '#';
+}
+
+foreach my $p (@output) {
+    my $v = $patches{$p};
+    my $pa = $v->{ParsedName};
+    my ($msgkind, $msg) = git_get_object("$pa->{Ref}:.topbloke/msg");
+    if ($msgkind ne 'blob') {
+       warn "$p $msgkind ?";
+       next;
+    }
+    my $subject =
+       $msg =~ m/^Subject:\s*(?:\[[^][]*\]\s*)?(.*\S)\s*$/mi
+       ? $1 : "[no subject]";  
+    printf("%1s%1s %s\@%s/%s/%-20s %s\n",
+          $p eq $current_patch ? $ifcurrent : '',
+          defined $v->{Meta}{'deleted'} ? 'D' : '',
+          $pa->{Email}, $pa->{Domain}, $pa->{Date}, $pa->{Nick},
+          $subject)
+       or die $!;
+}
+
+closeout();