![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
diff --git a/perl/Git.pm b/perl/Git.pm
index d99e7782002e01079b3866003cc8555b7e130e3f..102e6a4ce3f63ea5754eff581c17df325cc1e073 100644 (file)
--- a/perl/Git.pm
+++ b/perl/Git.pm
command_output_pipe command_input_pipe command_close_pipe
command_bidi_pipe command_close_bidi_pipe
version exec_path hash_object git_cmd_try
command_output_pipe command_input_pipe command_close_pipe
command_bidi_pipe command_close_bidi_pipe
version exec_path hash_object git_cmd_try
- remote_refs);
+ remote_refs
+ temp_acquire temp_release temp_reset);
=head1 DESCRIPTION
=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
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
=cut
use Error qw(:try);
use Cwd qw(abs_path);
use IPC::Open2 qw(open2);
use Error qw(:try);
use Cwd qw(abs_path);
use IPC::Open2 qw(open2);
-
+use Fcntl qw(SEEK_SET SEEK_CUR);
}
}
=cut
sub command_close_bidi_pipe {
=cut
sub command_close_bidi_pipe {
+ local $?;
my ($pid, $in, $out, $ctx) = @_;
foreach my $fh ($in, $out) {
unless (close $fh) {
my ($pid, $in, $out, $ctx) = @_;
foreach my $fh ($in, $out) {
unless (close $fh) {
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).
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.
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.
my @vars = map { 'hash_object_' . $_ } qw(pid in out ctx);
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 )
}
=item cat_blob ( SHA1, FILEHANDLE )
my @vars = map { 'cat_blob_' . $_ } qw(pid in out ctx);
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) = @_;
+
+ _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<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
=back
=head1 ERROR HANDLING