![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
diff --git a/perl/Git.pm b/perl/Git.pm
index 6ba8ee5c0d209704fdf1c9d58f63579d3a7e0836..405f68fc391cdae158dde10f7128f4a3b8167860 100644 (file)
--- a/perl/Git.pm
+++ b/perl/Git.pm
@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);
+ version exec_path hash_object git_cmd_try
+ remote_refs
+ temp_acquire temp_release temp_reset);
=head1 DESCRIPTION
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
use Error qw(:try);
use Cwd qw(abs_path);
use IPC::Open2 qw(open2);
-
+use File::Temp ();
+require File::Spec;
+use Fcntl qw(SEEK_SET SEEK_CUR);
}
=cut
sub command_close_bidi_pipe {
+ local $?;
my ($pid, $in, $out, $ctx) = @_;
foreach my $fh ($in, $out) {
unless (close $fh) {
my $E = shift;
if ($E->value() == 1) {
# Key not found.
- return undef;
+ return;
} else {
throw $E;
}
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<refname =\> hash>. For tags, the C<refname> entry
+contains the tag object while a C<refname^{}> entry gives the tagged objects.
+
+C<REPOSITORY> has the same meaning as the appropriate C<git-ls-remote>
+argument; either an URL or a remote name (if called on a repository instance).
+C<GROUPS> is an optional arrayref that can contain 'tags' to return all the
+tags and/or 'heads' to return all the heads. C<REFGLOB> 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<git-ls-remote>
+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 )
in the commit and tag objects or produced by C<var GIT_type_IDENT> (thus
C<TYPE> can be either I<author> or I<committer>; case is insignificant).
-The C<ident> method retrieves the ident information from C<git-var>
+The C<ident> method retrieves the ident information from C<git var>
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.
=item hash_object ( TYPE, FILENAME )
-Compute the SHA1 object id of the given C<FILENAME> (or data waiting in
-C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob>,
-C<commit>, C<tree>).
+Compute the SHA1 object id of the given C<FILENAME> considering it is
+of the C<TYPE> object type (C<blob>, C<commit>, C<tree>).
The method can be called without any instance or on a specified Git repository,
it makes zero difference.
my @vars = map { 'hash_object_' . $_ } qw(pid in out ctx);
- command_close_bidi_pipe($self->{@vars});
- delete $self->{@vars};
+ command_close_bidi_pipe(@$self{@vars});
+ delete @$self{@vars};
}
=item cat_blob ( SHA1, FILEHANDLE )
my $description = <$in>;
if ($description =~ / missing$/) {
carp "$sha1 doesn't exist in the repository";
- return 0;
+ return -1;
}
if ($description !~ /^[0-9a-fA-F]{40} \S+ (\d+)$/) {
carp "Unexpected result returned from git cat-file";
- return 0;
+ return -1;
}
my $size = $1;
my @vars = map { 'cat_blob_' . $_ } qw(pid in out ctx);
- command_close_bidi_pipe($self->{@vars});
- delete $self->{@vars};
+ 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<NAME>. 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<NAME>. This lock must be released with
+C<temp_release()> when the temp file is no longer needed. Subsequent attempts
+to retrieve temporary files mapped to the same C<NAME> 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<File::Handle> 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<File::Temp> 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<temp_acquire()>. Can be called either with
+the C<NAME> mapping used when acquiring the temp file or with the C<FILEHANDLE>
+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) = @_;
+
+ 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;
+}
+
+=item temp_reset ( FILEHANDLE )
+
+Truncates and resets the position of the C<FILEHANDLE>.
+
+=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
=head1 ERROR HANDLING