wip tb-list

[topbloke.git] / Topbloke.pm

diff --git a/Topbloke.pm b/Topbloke.pm
index d33d87f7dc77f8cbddb5f1ed23c8dc19cb749cde..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,12 +21,15 @@ 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 = ( );
     @EXPORT_OK   = qw();
 }
 
+our $git_command = 'git';
+
 sub debug ($) {
     my ($msg) = @_;
     print STDERR "DEBUG: $msg\n" or die $!;
@@ -49,18 +53,18 @@ sub run_git {
            die ref($ref)." @_ ?";
        }
     }
-    open GIT, "-|", 'git', @_ or die $!;
+    open GIT, "-|", $git_command, @_ or die $!;
     if ($linecallr) {
        while (<GIT>) {
-           chomp or die "$_ ?";
+           chomp or die "$git_command @_ gave $_ ?";
            $linecallr->();
        }
        GIT->eof or die $!;
     }
     if (!close GIT) {
-       die "git @_ $!" if $!;
+       die "$git_command @_ $!" if $!;
        die unless $?;
-       die "git @_ ($?)" unless $estatusr;
+       die "$git_command @_ ($?)" unless $estatusr;
        $$estatusr = $?;
     } else {
        $$estatusr = 0 if $estatusr;
@@ -85,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);
@@ -152,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;
@@ -199,8 +242,9 @@ sub parse_patch_spec ($) {
        @l >= $rel_levels or
            die "relative patch spec \`$orig' has too many ../s\n";
        $_ = (join '/', @l[0..$#l-$rel_levels]).'/'.$_;
+    } elsif (length) {
+       $spec->{Nick} = $_;
     }
-    $spec->{Nick} = $_;
     return $spec;
 }
 
@@ -265,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) = @_;