lib/PublicInbox/GitCatFile.pm

   1 # Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
   2 # License: GPLv2 or later (https://www.gnu.org/licenses/gpl-2.0.txt)
   3 # This is based on code in Git.pm which is GPLv2, but modified to avoid
   4 # dependence on environment variables for compatibility with mod_perl.
   5 # There are also API changes to simplify our usage and data set.
   6 package PublicInbox::GitCatFile;
   7 use strict;
   8 use warnings;
   9 use IPC::Open2 qw(open2);
  10
  11 sub new {
  12         my ($class, $git_dir) = @_;
  13         bless { git_dir => $git_dir }, $class;
  14 }
  15
  16 sub _cat_file_begin {
  17         my ($self) = @_;
  18         return if $self->{pid};
  19         my ($in, $out);
  20         my $pid = open2($in, $out, 'git', '--git-dir', $self->{git_dir},
  21                         'cat-file', '--batch');
  22
  23         $self->{pid} = $pid;
  24         $self->{in} = $in;
  25         $self->{out} = $out;
  26 }
  27
  28 sub cat_file {
  29         my ($self, $object) = @_;
  30
  31         $self->_cat_file_begin;
  32         print { $self->{out} } $object, "\n" or die "write error: $!\n";
  33
  34         my $in = $self->{in};
  35         my $head = <$in>;
  36         $head =~ / missing$/ and return undef;
  37         $head =~ /^[0-9a-f]{40} \S+ (\d+)$/ or
  38                 die "Unexpected result from git cat-file: $head\n";
  39
  40         my $size = $1;
  41         my $bytes_left = $size;
  42         my $buf;
  43         my $rv = '';
  44
  45         while ($bytes_left) {
  46                 my $read = read($in, $buf, $bytes_left);
  47                 defined($read) or die "read pipe failed: $!\n";
  48                 $rv .= $buf;
  49                 $bytes_left -= $read;
  50         }
  51
  52         my $read = read($in, $buf, 1);
  53         defined($read) or die "read pipe failed: $!\n";
  54         if ($read != 1 || $buf ne "\n") {
  55                 die "newline missing after blob\n";
  56         }
  57         \$rv;
  58 }
  59
  60 sub DESTROY {
  61         my ($self) = @_;
  62         my $pid = $self->{pid} or return;
  63         $self->{pid} = undef;
  64         foreach my $f (qw(in out)) {
  65                 my $fh = $self->{$f};
  66                 defined $fh or next;
  67                 close $fh;
  68                 $self->{$f} = undef;
  69         }
  70         waitpid $pid, 0;
  71 }
  72
  73 1;