X-Git-Url: https://git.tokkee.org/?a=blobdiff_plain;f=perl%2FGit.pm;h=102e6a4ce3f63ea5754eff581c17df325cc1e073;hb=88ab18dfef55a41df2e1f69a8ab3e3ed9f915c31;hp=2e7f896baec00d644903af5d967b6c781ee3503a;hpb=049a226fa14fb25c03d2146c2f8f184cfea5e5bf;p=git.git diff --git a/perl/Git.pm b/perl/Git.pm index 2e7f896ba..102e6a4ce 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,7 +55,10 @@ 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 - version exec_path hash_object git_cmd_try); + command_bidi_pipe command_close_bidi_pipe + version exec_path hash_object git_cmd_try + remote_refs + temp_acquire temp_release temp_reset); =head1 DESCRIPTION @@ -84,7 +91,7 @@ TODO: In the future, we might also do Currently, the module merely wraps calls to external Git tools. In the future, it will provide a much faster way to interact with Git by linking directly to libgit. This should be completely opaque to the user, though (performance -increate nonwithstanding). +increase notwithstanding). =cut @@ -92,7 +99,8 @@ 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); +use Fcntl qw(SEEK_SET SEEK_CUR); } @@ -216,7 +224,6 @@ sub repository { bless $self, $class; } - =back =head1 METHODS @@ -375,6 +382,61 @@ sub command_close_pipe { _cmd_close($fh, $ctx); } +=item command_bidi_pipe ( COMMAND [, ARGUMENTS... ] ) + +Execute the given C 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 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 and C as returned from C, +checking whether the command finished successfully. The optional C +argument is required if you want to see the command name in the error message, +and it is the fourth value returned by C. 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; +currently it is simply the command name but in future the context might +have more complicated structure. + +=cut + +sub command_close_bidi_pipe { + local $?; + 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... ] ) @@ -506,7 +568,7 @@ sub config { my $E = shift; if ($E->value() == 1) { # Key not found. - return undef; + return; } else { throw $E; } @@ -609,6 +671,59 @@ sub get_color { return $color; } +=item remote_refs ( REPOSITORY [, GROUPS [, REFGLOBS ] ] ) + +This function returns a hashref of refs stored in a given remote repository. +The hash is in the format C hash>. For tags, the C entry +contains the tag object while a C entry gives the tagged objects. + +C has the same meaning as the appropriate C +argument; either an URL or a remote name (if called on a repository instance). +C is an optional arrayref that can contain 'tags' to return all the +tags and/or 'heads' to return all the heads. C is an optional array +of strings containing a shell-like glob to further limit the refs returned in +the hash; the meaning is again the same as the appropriate C +argument. + +This function may or may not be called on a repository instance. In the former +case, remote names as defined in the repository are recognized as repository +specifiers. + +=cut + +sub remote_refs { + my ($self, $repo, $groups, $refglobs) = _maybe_self(@_); + my @args; + if (ref $groups eq 'ARRAY') { + foreach (@$groups) { + if ($_ eq 'heads') { + push (@args, '--heads'); + } elsif ($_ eq 'tags') { + push (@args, '--tags'); + } else { + # Ignore unknown groups for future + # compatibility + } + } + } + push (@args, $repo); + if (ref $refglobs eq 'ARRAY') { + push (@args, @$refglobs); + } + + my @self = $self ? ($self) : (); # Ultra trickery + my ($fh, $ctx) = Git::command_output_pipe(@self, 'ls-remote', @args); + my %refs; + while (<$fh>) { + chomp; + my ($hash, $ref) = split(/\t/, $_, 2); + $refs{$ref} = $hash; + } + Git::command_close_pipe(@self, $fh, $ctx); + return \%refs; +} + + =item ident ( TYPE | IDENTSTR ) =item ident_person ( TYPE | IDENTSTR | IDENTARRAY ) @@ -617,7 +732,7 @@ This suite of functions retrieves and parses ident information, as stored in the commit and tag objects or produced by C (thus C can be either I or I; case is insignificant). -The C method retrieves the ident information from C +The C method retrieves the ident information from C and either returns it as a scalar string or as an array with the fields parsed. Alternatively, it can take a prepared ident string (e.g. from the commit object) and just parse it. @@ -660,9 +775,8 @@ sub ident_person { =item hash_object ( TYPE, FILENAME ) -Compute the SHA1 object id of the given C (or data waiting in -C) considering it is of the C object type (C, -C, C). +Compute the SHA1 object id of the given C considering it is +of the C object type (C, C, C). The method can be called without any instance or on a specified Git repository, it makes zero difference. @@ -678,6 +792,272 @@ sub hash_object { } +=item hash_and_insert_object ( FILENAME ) + +Compute the SHA1 object id of the given C 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 to C 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 -1; + } + + if ($description !~ /^[0-9a-fA-F]{40} \S+ (\d+)$/) { + carp "Unexpected result returned from git cat-file"; + return -1; + } + + 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}; +} + + +{ # %TEMP_* Lexical Context + +my (%TEMP_LOCKS, %TEMP_FILES); + +=item temp_acquire ( NAME ) + +Attempts to retreive the temporary file mapped to the string C. If an +associated temp file has not been created this session or was closed, it is +created, cached, and set for autoflush and binmode. + +Internally locks the file mapped to C. This lock must be released with +C when the temp file is no longer needed. Subsequent attempts +to retrieve temporary files mapped to the same C while still locked will +cause an error. This locking mechanism provides a weak guarantee and is not +threadsafe. It does provide some error checking to help prevent temp file refs +writing over one another. + +In general, the L returned should not be closed by consumers as +it defeats the purpose of this caching mechanism. If you need to close the temp +file handle, then you should use L or another temp file faculty +directly. If a handle is closed and then requested again, then a warning will +issue. + +=cut + +sub temp_acquire { + my ($self, $name) = _maybe_self(@_); + + my $temp_fd = _temp_cache($name); + + $TEMP_LOCKS{$temp_fd} = 1; + $temp_fd; +} + +=item temp_release ( NAME ) + +=item temp_release ( FILEHANDLE ) + +Releases a lock acquired through C. Can be called either with +the C mapping used when acquiring the temp file or with the C +referencing a locked temp file. + +Warns if an attempt is made to release a file that is not locked. + +The temp file will be truncated before being released. This can help to reduce +disk I/O where the system is smart enough to detect the truncation while data +is in the output buffers. Beware that after the temp file is released and +truncated, any operations on that file may fail miserably until it is +re-acquired. All contents are lost between each release and acquire mapped to +the same string. + +=cut + +sub temp_release { + my ($self, $temp_fd, $trunc) = _maybe_self(@_); + + if (ref($temp_fd) ne 'File::Temp') { + $temp_fd = $TEMP_FILES{$temp_fd}; + } + unless ($TEMP_LOCKS{$temp_fd}) { + carp "Attempt to release temp file '", + $temp_fd, "' that has not been locked"; + } + temp_reset($temp_fd) if $trunc and $temp_fd->opened; + + $TEMP_LOCKS{$temp_fd} = 0; + undef; +} + +sub _temp_cache { + my ($name) = @_; + + _verify_require(); + + my $temp_fd = \$TEMP_FILES{$name}; + if (defined $$temp_fd and $$temp_fd->opened) { + if ($TEMP_LOCKS{$$temp_fd}) { + throw Error::Simple("Temp file with moniker '", + $name, "' already in use"); + } + } else { + if (defined $$temp_fd) { + # then we're here because of a closed handle. + carp "Temp file '", $name, + "' was closed. Opening replacement."; + } + $$temp_fd = File::Temp->new( + TEMPLATE => 'Git_XXXXXX', + DIR => File::Spec->tmpdir + ) or throw Error::Simple("couldn't open new temp file"); + $$temp_fd->autoflush; + binmode $$temp_fd; + } + $$temp_fd; +} + +sub _verify_require { + eval { require File::Temp; require File::Spec; }; + $@ and throw Error::Simple($@); +} + +=item temp_reset ( FILEHANDLE ) + +Truncates and resets the position of the C. + +=cut + +sub temp_reset { + my ($self, $temp_fd) = _maybe_self(@_); + + truncate $temp_fd, 0 + or throw Error::Simple("couldn't truncate file"); + sysseek($temp_fd, 0, SEEK_SET) and seek($temp_fd, 0, SEEK_SET) + or throw Error::Simple("couldn't seek to beginning of file"); + sysseek($temp_fd, 0, SEEK_CUR) == 0 and tell($temp_fd) == 0 + or throw Error::Simple("expected file position to be reset"); +} + +sub END { + unlink values %TEMP_FILES if %TEMP_FILES; +} + +} # %TEMP_* Lexical Context =back @@ -895,7 +1275,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.