diff options
Diffstat (limited to 'perl/Git.pm')
| -rw-r--r-- | perl/Git.pm | 208 |
1 files changed, 206 insertions, 2 deletions
diff --git a/perl/Git.pm b/perl/Git.pm index 2e7f896..6ba8ee5 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -39,6 +39,10 @@ $VERSION = '0.01'; my $lastrev = $repo->command_oneline( [ 'rev-list', '--all' ], STDERR => 0 ); + my $sha1 = $repo->hash_and_insert_object('file.txt'); + my $tempfile = tempfile(); + my $size = $repo->cat_blob($sha1, $tempfile); + =cut @@ -51,6 +55,7 @@ require Exporter; # Methods which can be called as standalone functions as well: @EXPORT_OK = qw(command command_oneline command_noisy command_output_pipe command_input_pipe command_close_pipe + command_bidi_pipe command_close_bidi_pipe version exec_path hash_object git_cmd_try); @@ -92,6 +97,7 @@ increate nonwithstanding). use Carp qw(carp croak); # but croak is bad - throw instead use Error qw(:try); use Cwd qw(abs_path); +use IPC::Open2 qw(open2); } @@ -216,7 +222,6 @@ sub repository { bless $self, $class; } - =back =head1 METHODS @@ -375,6 +380,60 @@ sub command_close_pipe { _cmd_close($fh, $ctx); } +=item command_bidi_pipe ( COMMAND [, ARGUMENTS... ] ) + +Execute the given C<COMMAND> in the same way as command_output_pipe() +does but return both an input pipe filehandle and an output pipe filehandle. + +The function will return return C<($pid, $pipe_in, $pipe_out, $ctx)>. +See C<command_close_bidi_pipe()> for details. + +=cut + +sub command_bidi_pipe { + my ($pid, $in, $out); + $pid = open2($in, $out, 'git', @_); + return ($pid, $in, $out, join(' ', @_)); +} + +=item command_close_bidi_pipe ( PID, PIPE_IN, PIPE_OUT [, CTX] ) + +Close the C<PIPE_IN> and C<PIPE_OUT> as returned from C<command_bidi_pipe()>, +checking whether the command finished successfully. The optional C<CTX> +argument is required if you want to see the command name in the error message, +and it is the fourth value returned by C<command_bidi_pipe()>. The call idiom +is: + + my ($pid, $in, $out, $ctx) = $r->command_bidi_pipe('cat-file --batch-check'); + print "000000000\n" $out; + while (<$in>) { ... } + $r->command_close_bidi_pipe($pid, $in, $out, $ctx); + +Note that you should not rely on whatever actually is in C<CTX>; +currently it is simply the command name but in future the context might +have more complicated structure. + +=cut + +sub command_close_bidi_pipe { + my ($pid, $in, $out, $ctx) = @_; + foreach my $fh ($in, $out) { + unless (close $fh) { + if ($!) { + carp "error closing pipe: $!"; + } elsif ($? >> 8) { + throw Git::Error::Command($ctx, $? >>8); + } + } + } + + waitpid $pid, 0; + + if ($? >> 8) { + throw Git::Error::Command($ctx, $? >>8); + } +} + =item command_noisy ( COMMAND [, ARGUMENTS... ] ) @@ -678,6 +737,147 @@ sub hash_object { } +=item hash_and_insert_object ( FILENAME ) + +Compute the SHA1 object id of the given C<FILENAME> and add the object to the +object database. + +The function returns the SHA1 hash. + +=cut + +# TODO: Support for passing FILEHANDLE instead of FILENAME +sub hash_and_insert_object { + my ($self, $filename) = @_; + + carp "Bad filename \"$filename\"" if $filename =~ /[\r\n]/; + + $self->_open_hash_and_insert_object_if_needed(); + my ($in, $out) = ($self->{hash_object_in}, $self->{hash_object_out}); + + unless (print $out $filename, "\n") { + $self->_close_hash_and_insert_object(); + throw Error::Simple("out pipe went bad"); + } + + chomp(my $hash = <$in>); + unless (defined($hash)) { + $self->_close_hash_and_insert_object(); + throw Error::Simple("in pipe went bad"); + } + + return $hash; +} + +sub _open_hash_and_insert_object_if_needed { + my ($self) = @_; + + return if defined($self->{hash_object_pid}); + + ($self->{hash_object_pid}, $self->{hash_object_in}, + $self->{hash_object_out}, $self->{hash_object_ctx}) = + command_bidi_pipe(qw(hash-object -w --stdin-paths)); +} + +sub _close_hash_and_insert_object { + my ($self) = @_; + + return unless defined($self->{hash_object_pid}); + + my @vars = map { 'hash_object_' . $_ } qw(pid in out ctx); + + command_close_bidi_pipe($self->{@vars}); + delete $self->{@vars}; +} + +=item cat_blob ( SHA1, FILEHANDLE ) + +Prints the contents of the blob identified by C<SHA1> to C<FILEHANDLE> and +returns the number of bytes printed. + +=cut + +sub cat_blob { + my ($self, $sha1, $fh) = @_; + + $self->_open_cat_blob_if_needed(); + my ($in, $out) = ($self->{cat_blob_in}, $self->{cat_blob_out}); + + unless (print $out $sha1, "\n") { + $self->_close_cat_blob(); + throw Error::Simple("out pipe went bad"); + } + + my $description = <$in>; + if ($description =~ / missing$/) { + carp "$sha1 doesn't exist in the repository"; + return 0; + } + + if ($description !~ /^[0-9a-fA-F]{40} \S+ (\d+)$/) { + carp "Unexpected result returned from git cat-file"; + return 0; + } + + my $size = $1; + + my $blob; + my $bytesRead = 0; + + while (1) { + my $bytesLeft = $size - $bytesRead; + last unless $bytesLeft; + + my $bytesToRead = $bytesLeft < 1024 ? $bytesLeft : 1024; + my $read = read($in, $blob, $bytesToRead, $bytesRead); + unless (defined($read)) { + $self->_close_cat_blob(); + throw Error::Simple("in pipe went bad"); + } + + $bytesRead += $read; + } + + # Skip past the trailing newline. + my $newline; + my $read = read($in, $newline, 1); + unless (defined($read)) { + $self->_close_cat_blob(); + throw Error::Simple("in pipe went bad"); + } + unless ($read == 1 && $newline eq "\n") { + $self->_close_cat_blob(); + throw Error::Simple("didn't find newline after blob"); + } + + unless (print $fh $blob) { + $self->_close_cat_blob(); + throw Error::Simple("couldn't write to passed in filehandle"); + } + + return $size; +} + +sub _open_cat_blob_if_needed { + my ($self) = @_; + + return if defined($self->{cat_blob_pid}); + + ($self->{cat_blob_pid}, $self->{cat_blob_in}, + $self->{cat_blob_out}, $self->{cat_blob_ctx}) = + command_bidi_pipe(qw(cat-file --batch)); +} + +sub _close_cat_blob { + my ($self) = @_; + + return unless defined($self->{cat_blob_pid}); + + my @vars = map { 'cat_blob_' . $_ } qw(pid in out ctx); + + command_close_bidi_pipe($self->{@vars}); + delete $self->{@vars}; +} =back @@ -895,7 +1095,11 @@ sub _cmd_close { } -sub DESTROY { } +sub DESTROY { + my ($self) = @_; + $self->_close_hash_and_insert_object(); + $self->_close_cat_blob(); +} # Pipe implementation for ActiveState Perl. |