wip tb-list

diff --git a/Topbloke.pm b/Topbloke.pm
index fac5c35d6957b09355b25a208535995c97043da2..f5c469fe48515c99abbb43696223133ad0769350 100644 (file)
--- a/Topbloke.pm
+++ b/Topbloke.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use POSIX;
 use IO::File;
+use IPC::Open2;
 
 package Topbloke;
 
@@ -20,6 +21,7 @@ BEGIN {
                      git_config git_dir chdir_toplevel
                      current_branch parse_patch_spec
                      setup_config check_no_unwanted_metadata
+                     foreach_patch
                      flagsfile_add_flag
                      wf_start wf wf_abort wf_done wf_contents);
     %EXPORT_TAGS = ( );
@@ -87,6 +89,31 @@ sub run_git_test_anyoutput {
     return $any;
 }
 
+sub git_get_object ($) {
+    my ($objname) = @_;
+    our ($gro_pid, $gro_out, $gro_in);
+    if (!$gro_pid) {
+       $gro_pid = IPC::Open2::open2($gro_out, $gro_in,
+                                    $git_command, qw(cat-file --batch))
+           or die $!;
+    }
+    $SIG{'PIPE'} = 'IGN';
+    print $gro_in $objname,"\n" or die $!;
+    $gro_in->flush or die "$objname $!";
+    $SIG{'PIPE'} = 'DFL';
+    my $l = <$gro_out>;
+    chomp $l or die "$objname $l ?";
+    if ($l =~ m/ missing$/) {
+       return 'missing';
+    } elsif (my ($type,$bytes) = $l =~ m/^\S+ (\w+) (\d+)$/) {
+       my $data;
+       read $gro_out, $data, $bytes == $bytes or die "$objname $!";
+       return ($type, $data);
+    } else {
+       die "$objname $l";
+    }
+}
+
 sub git_config ($$) {
     my ($cfgvar, $default) = @_;
     my ($l, $estatus);
@@ -154,6 +181,20 @@ sub current_branch () {
     }
 }
 
+sub parse_patch_name ($) {
+    my ($patch) = @_;
+    my ($eaddr, $date, $nick) = split /\//, $patch, 3;
+    defined $nick && length $nick or die "$patch ?";
+    my ($email, $domain) = $eaddr =~ m/^(.*)\@([^\@]+)$/
+       or die "$patch eaddr ?";
+    return {
+       Email => $email,
+       Domain => $domain,
+       Date => $date,
+       Nick => $nick,
+    };
+}
+
 sub parse_patch_spec ($) {
     my ($orig) = @_;
     local $_ = $orig;
@@ -268,6 +309,64 @@ sub check_no_unwanted_metadata ($) {
                           qw(.topbloke));
 }
 
+sub foreach_patch ($$$$) {
+    my ($spec, $deleted_ok, $want, $body) = @_;
+    # runs $body->($fullname, \%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
+    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)) {
+
+           if ($file eq 'deps') {
+               # do this check after checking for deleted patches,
+               # so we don't parse deleted patches' names
+               # 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};
+               }
+           }
+
+           if (!shift @$want) {
+               push @out, undef;
+               next;
+           }
+
+           my ($got, $data) = git_get_object("$objname:.topbloke/$file");
+           die "$patch $file ?" unless defined $data;
+           my %data;
+           $data{$_}=1 foreach split /\n/, $data;
+
+           if ($file eq 'flags') {
+               debug("foreach_patch  Deleted"), return
+                   if !$deleted_ok && $data{Deleted};
+           }
+
+           push @out, \%data;
+       }
+       debug("foreach_patch  YES @out"), return
+       $body->(@out);
+           },
+           qw(for-each-ref --format), '%(objectname) %(refname)',
+               qw(refs/topbloke-tips));
+}
+
 sub flagsfile_add_flag ($$) {
     # works on "deps" too
     my ($flagsfile, $flag) = @_;

diff --git a/tb-list.pl b/tb-list.pl
new file mode 100755 (executable)
index 0000000..6be99af
--- /dev/null
+++ b/tb-list.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+# usage: tb-list [<patch-spec>]
+#  lists all patches matching <patch-spec> and other criteria
+
+use warnings;
+use strict;
+
+use Getopt::Long;
+use Topbloke;
+
+Getopt::Long::Configure(qw(bundling));
+
+our $deleted=0;
+our $deleted_only=0;
+our $current=0;
+our $related=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
+          "l|last|leaf|leaves" => \$leaves, # only leaf patches
+          "sort=s" => \$sort,
+    ) or die "bad options\n";
+
+our $spec;
+
+if (@ARGV==1) {
+    $spec = parse_patch_spec($ARGV[0]);
+} elsif (!@ARGV) {
+} else {
+    die "too many arguments\n";
+}
+
+our @sort = grep { /./ } split m/,/, $sort;
+push @sort, $spec ? 'created' : 'topo';
+foreach $sort (@sort) {
+    die "bad sort $sort\n" unless grep { $_ eq $sort } 
+        qw(fullname created nick topo);
+}
+
+use Data::Dumper;
+
+foreach_patch($spec, $deleted || $deleted_only, [], sub {
+    print Dumper(\@_);
+             });