tb-list works

diff --git a/Topbloke.pm b/Topbloke.pm
index 56055cf688bb42dc3a007c5603c7c2499b3b3fad..b6de69022bd325306cdc6109394888c3507bebf6 100644 (file)
--- a/Topbloke.pm
+++ b/Topbloke.pm
@@ -17,13 +17,15 @@ BEGIN {
     @ISA         = qw(Exporter);
     @EXPORT      = qw(debug
                      run_git run_git_1line run_git_check_nooutput
     @ISA         = qw(Exporter);
     @EXPORT      = qw(debug
                      run_git run_git_1line run_git_check_nooutput

-                     run_git_test_anyoutput
+                     run_git_test_anyoutput git_get_object

                      git_config git_dir chdir_toplevel
                      git_config git_dir chdir_toplevel

-                     current_branch parse_patch_spec
+                     current_branch parse_patch_spec parse_patch_name

                      setup_config check_no_unwanted_metadata
                      setup_config check_no_unwanted_metadata

+                     patch_matches_spec

                      foreach_patch
                      flagsfile_add_flag
                      foreach_patch
                      flagsfile_add_flag

-                     wf_start wf wf_abort wf_done wf_contents);
+                     wf_start wf wf_abort wf_done wf_contents
+                     closeout);

     %EXPORT_TAGS = ( );
     @EXPORT_OK   = qw();
 }
     %EXPORT_TAGS = ( );
     @EXPORT_OK   = qw();
 }


@@ -97,17 +99,24 @@ sub git_get_object ($) {
                                     $git_command, qw(cat-file --batch))
            or die $!;
     }
                                     $git_command, qw(cat-file --batch))
            or die $!;
     }

+    #debug("git_get_object $objname");

     $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 ?";
     $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 ?";

+    #debug("git_get_object $objname => $l");

     if ($l =~ m/ missing$/) {
        return 'missing';
     } elsif (my ($type,$bytes) = $l =~ m/^\S+ (\w+) (\d+)$/) {
     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 $!";
+       my $data = '';
+       if ($bytes) {
+           (read $gro_out, $data, $bytes) == $bytes or die "$objname $!";
+       }
+       my $nl;
+       (read $gro_out, $nl, 1) == 1 or die "$objname $!";
+       $nl eq "\n" or die "$objname ?";

        return ($type, $data);
     } else {
        die "$objname $l";
        return ($type, $data);
     } else {
        die "$objname $l";


@@ -158,6 +167,7 @@ sub current_branch () {
        };
     }
     if ($ref =~ m#^refs/topbloke-(tip|base)s/([^/\@]*)\@([^/\@]*)/([^/]*)/#) {
        };
     }
     if ($ref =~ m#^refs/topbloke-(tip|base)s/([^/\@]*)\@([^/\@]*)/([^/]*)/#) {

+       my $fullname = "$2\@$3/$4/$'";

        return {
            Kind => $1,
            Email => $2,
        return {
            Kind => $1,
            Email => $2,


@@ -165,7 +175,8 @@ sub current_branch () {
            Date => $4,
            Nick => $', #',
            Ref => $ref,
            Date => $4,
            Nick => $', #',
            Ref => $ref,

-           DepSpec => "$2\@$3/$4/$'",
+           DepSpec => $fullname,
+           Fullname => $fullname,

        };
     } elsif ($ref =~ m#^refs/heads/#) {
        return {
        };
     } elsif ($ref =~ m#^refs/heads/#) {
        return {


@@ -192,6 +203,10 @@ sub parse_patch_name ($) {
        Domain => $domain,
        Date => $date,
        Nick => $nick,
        Domain => $domain,
        Date => $date,
        Nick => $nick,

+       Kind => 'tip',
+       DepSpec => $patch,
+       Fullname => $patch,
+       Ref => "refs/topbloke-tips/$patch",

     };
 }
 
     };
 }
 


@@ -427,4 +442,9 @@ sub wf_contents ($$) {
     wf_done($wf);
 }
 
     wf_done($wf);
 }
 

+sub closeout () {
+    STDOUT->error and die $!;
+    close STDOUT or die $!;
+}
+

 1;
 1;

diff --git a/tb-list.pl b/tb-list.pl
index 6a4466b5fdb4102f71bd82f31472ddb41535d2ba..e1fea3981c919b894943e03a36492730a8131025 100755 (executable)
--- a/tb-list.pl
+++ b/tb-list.pl
@@ -43,6 +43,8 @@ foreach $sort (@sort) {
     $toposort=1 if $sort eq $toposort;
 }
 
     $toposort=1 if $sort eq $toposort;
 }
 

+$relatedto = $relatedto ? parse_patch_spec($relatedto) : undef;
+

 our %patches;
 
 foreach_patch($relatedto || $leaves || !$spec ? { } : $spec, 
 our %patches;
 
 foreach_patch($relatedto || $leaves || !$spec ? { } : $spec, 


@@ -82,6 +84,8 @@ if ($relatedto) {
                next unless exists $patches{$dep};
                $patches{$dep}{Related} = 1;
            }
                next unless exists $patches{$dep};
                $patches{$dep}{Related} = 1;
            }

+           # oh, and mark ourselves as Related=1 too!
+           $v->{Related} = 1;

        }
     }
 }
        }
     }
 }


@@ -94,6 +98,7 @@ foreach my $p (keys %patches) {
     next if $deleted_only && !$v->{Info}[0]{Deleted};
     next if $leaves && $v->{NotLeaf};
     next if $relatedto && !$v->{Related};
     next if $deleted_only && !$v->{Info}[0]{Deleted};
     next if $leaves && $v->{NotLeaf};
     next if $relatedto && !$v->{Related};

+    next if $spec && !patch_matches_spec($v->{ParsedName}, $spec);

     push @output, $p;
 }
 
     push @output, $p;
 }
 


@@ -145,7 +150,24 @@ eval sortsub()." 1;" or die "$@ ?";
 
 use Data::Dumper;
 
 
 use Data::Dumper;
 

+my $current_branch = current_branch();
+my $current_patch = $current_branch->{Kind} eq 'tip'
+    ? $current_branch->{Fullname} : '';
+

 foreach my $p (@output) {
     my $v = $patches{$p};
 foreach my $p (@output) {
     my $v = $patches{$p};

-    print Dumper($p, $v);
+    my $pa = $v->{ParsedName};
+    my ($msgkind, $msg) = git_get_object("$pa->{Ref}:.topbloke/msg");
+    die "$p $msgkind ?" unless $msgkind eq 'blob';
+    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 ? '>' : '',
+          $v->{Info}[0]{Deleted} ? 'D' : '',
+          $pa->{Email}, $pa->{Domain}, $pa->{Date}, $pa->{Nick},
+          $subject)
+       or die $!;

 }
 }

+
+closeout();