git: cat-file wrapper enhancements

The "cat_file" sub now allows a block to be passed for partial
processing.  Additionally, a new "check" method is added to
retrieve only object metadata: (SHA-1 identifier, type, size)

1 files changed, 83 insertions, 42 deletions

diff --git a/lib/PublicInbox/GitCatFile.pm b/lib/PublicInbox/GitCatFile.pm
index dd95d5f3..b3666a08 100644
--- a/lib/PublicInbox/GitCatFile.pm
+++ b/lib/PublicInbox/GitCatFile.pm
@@ -17,75 +17,116 @@ sub new {
         bless { git_dir => $git_dir }, $class
 }
 
-sub _cat_file_begin {
-        my ($self) = @_;
-        return if $self->{pid};
+sub _bidi_pipe {
+        my ($self, $batch, $in, $out, $pid) = @_;
+        return if $self->{$pid};
         my ($in_r, $in_w, $out_r, $out_w);
 
-        pipe($in_r, $in_w) or die "pipe failed: $!\n";
-        pipe($out_r, $out_w) or die "pipe failed: $!\n";
+        pipe($in_r, $in_w) or fail($self, "pipe failed: $!");
+        pipe($out_r, $out_w) or fail($self, "pipe failed: $!");
 
-        my @cmd = ('git', "--git-dir=$self->{git_dir}", qw(cat-file --batch));
-        my $pid = fork;
-        defined $pid or die "fork failed: $!\n";
-        if ($pid == 0) {
+        my @cmd = ('git', "--git-dir=$self->{git_dir}", qw(cat-file), $batch);
+        $self->{$pid} = fork;
+        defined $self->{$pid} or fail($self, "fork failed: $!");
+        if ($self->{$pid} == 0) {
                 dup2(fileno($out_r), 0) or die "redirect stdin failed: $!\n";
                 dup2(fileno($in_w), 1) or die "redirect stdout failed: $!\n";
                 exec(@cmd) or die 'exec `' . join(' '). "' failed: $!\n";
         }
-        close $out_r or die "close failed: $!\n";
-        close $in_w or die "close failed: $!\n";
+        close $out_r or fail($self, "close failed: $!");
+        close $in_w or fail($self, "close failed: $!");
         $out_w->autoflush(1);
-
-        $self->{in} = $in_r;
-        $self->{out} = $out_w;
-        $self->{pid} = $pid;
+        $self->{$out} = $out_w;
+        $self->{$in} = $in_r;
 }
 
 sub cat_file {
-        my ($self, $object, $sizeref) = @_;
+        my ($self, $obj, $ref) = @_;
 
-        $self->_cat_file_begin;
-        print { $self->{out} } $object, "\n" or die "pipe write error: $!\n";
+        $self->_bidi_pipe(qw(--batch in out pid));
+        $self->{out}->print($obj, "\n") or fail($self, "write error: $!");
 
         my $in = $self->{in};
-        my $head = <$in>;
+        my $head = $in->getline;
         $head =~ / missing$/ and return undef;
         $head =~ /^[0-9a-f]{40} \S+ (\d+)$/ or
-                die "Unexpected result from git cat-file: $head\n";
+                fail($self, "Unexpected result from git cat-file: $head");
 
         my $size = $1;
-        $$sizeref = $size if $sizeref;
-        my $bytes_left = $size;
-        my $offset = 0;
-        my $rv = '';
-
-        while ($bytes_left) {
-                my $read = read($in, $rv, $bytes_left, $offset);
-                defined($read) or die "sysread pipe failed: $!\n";
-                $bytes_left -= $read;
-                $offset += $read;
-        }
+        my $ref_type = $ref ? ref($ref) : '';
+
+        my $rv;
+        my $left = $size;
+        $$ref = $size if ($ref_type eq 'SCALAR');
+        my $cb_err;
 
-        my $read = read($in, my $buf, 1);
-        defined($read) or die "read pipe failed: $!\n";
-        if ($read != 1 || $buf ne "\n") {
-                die "newline missing after blob\n";
+        if ($ref_type eq 'CODE') {
+                $rv = eval { $ref->($in, \$left) };
+                $cb_err = $@;
+                # drain the rest
+                my $max = 8192;
+                while ($left > 0) {
+                        my $r = read($in, my $x, $left > $max ? $max : $left);
+                        defined($r) or fail($self, "read failed: $!");
+                        $r == 0 and fail($self, 'exited unexpectedly');
+                        $left -= $r;
+                }
+        } else {
+                my $offset = 0;
+                my $buf = '';
+                while ($left > 0) {
+                        my $r = read($in, $buf, $left, $offset);
+                        defined($r) or fail($self, "read failed: $!");
+                        $r == 0 and fail($self, 'exited unexpectedly');
+                        $left -= $r;
+                        $offset += $r;
+                }
+                $rv = \$buf;
         }
-        \$rv;
+
+        my $r = read($in, my $buf, 1);
+        defined($r) or fail($self, "read failed: $!");
+        fail($self, 'newline missing after blob') if ($r != 1 || $buf ne "\n");
+        die $cb_err if $cb_err;
+
+        $rv;
 }
 
-sub DESTROY {
-        my ($self) = @_;
-        my $pid = $self->{pid} or return;
-        $self->{pid} = undef;
-        foreach my $f (qw(in out)) {
+sub check {
+        my ($self, $obj) = @_;
+        $self->_bidi_pipe(qw(--batch-check in_c out_c pid_c));
+        $self->{out_c}->print($obj, "\n") or fail($self, "write error: $!");
+        chomp(my $line = $self->{in_c}->getline);
+        my ($hex, $type, $size) = split(' ', $line);
+        return if $type eq 'missing';
+        ($hex, $type, $size);
+}
+
+sub _destroy {
+        my ($self, $in, $out, $pid) = @_;
+        my $p = $self->{$pid} or return;
+        $self->{$pid} = undef;
+        foreach my $f ($in, $out) {
                 my $fh = $self->{$f};
                 defined $fh or next;
                 close $fh;
                 $self->{$f} = undef;
         }
-        waitpid $pid, 0;
+        waitpid $p, 0;
+}
+
+sub fail {
+        my ($self, $msg) = @_;
+        cleanup($self);
+        die $msg;
 }
 
+sub cleanup {
+        my ($self) = @_;
+        _destroy($self, qw(in out pid));
+        _destroy($self, qw(in_c out_c pid_c));
+}
+
+sub DESTROY { cleanup(@_) }
+
 1;