wip list

diff --git a/Topbloke.pm b/Topbloke.pm
index f5c469fe48515c99abbb43696223133ad0769350..56055cf688bb42dc3a007c5603c7c2499b3b3fad 100644 (file)
--- a/Topbloke.pm
+++ b/Topbloke.pm
@@ -309,19 +309,34 @@ sub check_no_unwanted_metadata ($) {
                           qw(.topbloke));
 }
 
+sub patch_matches_spec ($$) {
+    my ($parsedname, $spec) = @_;
+    foreach my $k (qw(Email Domain Nick)) {
+       debug("patch_matches_spec  mismatch $k"), return 0
+           if defined $spec->{$k} &&
+              $parsedname->{$k} ne $spec->{$k};
+    }
+    debug("patch_matches_spec  mismatch DatePrefix"), return 0
+       if defined $spec->{DatePrefix} &&
+          substr($parsedname->{Date}, 0, length $spec->{DatePrefix})
+              ne $spec->{DatePrefix};
+    debug("patch_matches_spec  match"), return 1;
+}
+
 sub foreach_patch ($$$$) {
     my ($spec, $deleted_ok, $want, $body) = @_;
-    # runs $body->($fullname, \%flags, \%deps, \%pflags, \%included)
-    #                        $Want->[0]   1        2         3
+    # runs $body->($patch, $parsedname, \%flags, \%deps, \%pflags, \%included)
+    #                                   $want->[0]   1        2         3
     # where $deps->{$fullname} etc. are 1 for true or nonexistent for false
     #  and if $want->[$item] is not true, the corresponding item may be undef
+    # and $parsedname is only valid if $spec is not undef
+    #  (say $spec { }  if you want the name parsed but no restrictions)
     run_git(sub {
        debug("foreach_patch considering $_");
        m/ / or die "$_ ?";
        my $objname = $`;
        my @out;
        my $patch = substr($',19); #');
-       push @out, $patch;
        $want->[0] ||= !$deleted_ok;
        foreach my $file (qw(flags deps pflags included)) {
 
@@ -331,15 +346,11 @@ sub foreach_patch ($$$$) {
                # right, check the spec next
                if ($spec) {
                    my $have = parse_patch_name($patch);
-                   foreach my $k (qw(Email Domain Nick)) {
-                       debug("foreach_patch  mismatch $k"), return
-                           if defined $spec->{$k} &&
-                              $have->{$k} ne $spec->{$k};
-                   }
-                   debug("foreach_patch  mismatch DatePrefix"), return
-                       if defined $spec->{DatePrefix} &&
-                          substr($have->{Date}, 0, length $spec->{DatePrefix})
-                              ne $spec->{DatePrefix};
+                   debug("foreach_patch  mismatch"), return
+                       unless patch_matches_spec($have, $spec);
+                   unshift @out, $have;
+               } else {
+                   unshift @out, undef;
                }
            }
 
@@ -361,7 +372,7 @@ sub foreach_patch ($$$$) {
            push @out, \%data;
        }
        debug("foreach_patch  YES @out"), return
-       $body->(@out);
+       $body->($patch, @out);
            },
            qw(for-each-ref --format), '%(objectname) %(refname)',
                qw(refs/topbloke-tips));

diff --git a/tb-list.pl b/tb-list.pl
index 6be99afd41cc10d4a157ca592e8f3a8677be2d7f..6a4466b5fdb4102f71bd82f31472ddb41535d2ba 100755 (executable)
--- a/tb-list.pl
+++ b/tb-list.pl
@@ -13,13 +13,13 @@ Getopt::Long::Configure(qw(bundling));
 our $deleted=0;
 our $deleted_only=0;
 our $current=0;
-our $related=0;
+our $relatedto=0;
 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" => \$relatedto,     # only patches related to this one
           "l|last|leaf|leaves" => \$leaves, # only leaf patches
           "sort=s" => \$sort,
     ) or die "bad options\n";
@@ -34,14 +34,118 @@ if (@ARGV==1) {
 }
 
 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);
+    $toposort=1 if $sort eq $toposort;
 }
 
-use Data::Dumper;
+our %patches;
 
-foreach_patch($spec, $deleted || $deleted_only, [], sub {
-    print Dumper(\@_);
+foreach_patch($relatedto || $leaves || !$spec ? { } : $spec, 
+             $deleted || $deleted_only, 
+             [0, !!$leaves, 0, $toposort || !!$relatedto],
+             sub { 
+                 my ($patch,$parsedname,@info) = @_;
+                 $patches{$patch}{Info} = \@info;
+                 $patches{$patch}{ParsedName} = $parsedname;
              });
+
+if ($leaves) {
+    foreach my $p (keys %patches) {
+       my $v = $patches{$p};
+       next if $v->{Info}[0]{Deleted};
+       foreach my $dep (keys %{ $v->{Info}[1] }) {
+           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->{Info}[3] }) {
+           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->{Info}[3] }) {
+               next unless exists $patches{$dep};
+               $patches{$dep}{Related} = 1;
+           }
+       }
+    }
+}
+
+our @output;
+
+foreach my $p (keys %patches) {
+    my $v = $patches{$p};
+    next if !$deleted && $v->{Info}[0]{Deleted};
+    next if $deleted_only && !$v->{Info}[0]{Deleted};
+    next if $leaves && $v->{NotLeaf};
+    next if $relatedto && !$v->{Related};
+    push @output, $p;
+}
+
+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}->{Info}[3]{\$$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;
+
+use Data::Dumper;
+
+foreach my $p (@output) {
+    my $v = $patches{$p};
+    print Dumper($p, $v);
+}