From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 22 Jan 2012 23:28:38 +0000 (+0000)
Subject: wip tb-list
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=commitdiff_plain;h=83d7f96819431734fc09891439ffdcc27b67aa3b

wip tb-list
---

diff --git a/Topbloke.pm b/Topbloke.pm
index fac5c35..f5c469f 100644
--- 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
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(\@_);
+	      });