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
# 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);
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);
}
bless $self, $class;
}
-
=back
=head1 METHODS
_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... ] )
(exception is thrown otherwise), in array context returns allows the
variable to be set multiple times and returns all the values.
-Must be called on a repository instance.
-
This currently wraps command('config') so it is not so fast.
=cut
sub config {
- my ($self, $var) = @_;
- $self->repo_path()
- or throw Error::Simple("not a repository");
+ my ($self, $var) = _maybe_self(@_);
try {
+ my @cmd = ('config');
+ unshift @cmd, $self if $self;
if (wantarray) {
- return $self->command('config', '--get-all', $var);
+ return command(@cmd, '--get-all', $var);
+ } else {
+ return command_oneline(@cmd, '--get', $var);
+ }
+ } catch Git::Error::Command with {
+ my $E = shift;
+ if ($E->value() == 1) {
+ # Key not found.
+ return;
+ } else {
+ throw $E;
+ }
+ };
+}
+
+
+=item config_bool ( VARIABLE )
+
+Retrieve the bool configuration C<VARIABLE>. The return value
+is usable as a boolean in perl (and C<undef> if it's not defined,
+of course).
+
+This currently wraps command('config') so it is not so fast.
+
+=cut
+
+sub config_bool {
+ my ($self, $var) = _maybe_self(@_);
+
+ try {
+ my @cmd = ('config', '--bool', '--get', $var);
+ unshift @cmd, $self if $self;
+ my $val = command_oneline(@cmd);
+ return undef unless defined $val;
+ return $val eq 'true';
+ } catch Git::Error::Command with {
+ my $E = shift;
+ if ($E->value() == 1) {
+ # Key not found.
+ return undef;
} else {
- return $self->command_oneline('config', '--get', $var);
+ throw $E;
}
+ };
+}
+
+=item config_int ( VARIABLE )
+
+Retrieve the integer configuration C<VARIABLE>. The return value
+is simple decimal number. An optional value suffix of 'k', 'm',
+or 'g' in the config file will cause the value to be multiplied
+by 1024, 1048576 (1024^2), or 1073741824 (1024^3) prior to output.
+It would return C<undef> if configuration variable is not defined,
+
+This currently wraps command('config') so it is not so fast.
+
+=cut
+
+sub config_int {
+ my ($self, $var) = _maybe_self(@_);
+
+ try {
+ my @cmd = ('config', '--int', '--get', $var);
+ unshift @cmd, $self if $self;
+ return command_oneline(@cmd);
} catch Git::Error::Command with {
my $E = shift;
if ($E->value() == 1) {
};
}
+=item get_colorbool ( NAME )
+
+Finds if color should be used for NAMEd operation from the configuration,
+and returns boolean (true for "use color", false for "do not use color").
+
+=cut
+
+sub get_colorbool {
+ my ($self, $var) = @_;
+ my $stdout_to_tty = (-t STDOUT) ? "true" : "false";
+ my $use_color = $self->command_oneline('config', '--get-colorbool',
+ $var, $stdout_to_tty);
+ return ($use_color eq 'true');
+}
+
+=item get_color ( SLOT, COLOR )
+
+Finds color for SLOT from the configuration, while defaulting to COLOR,
+and returns the ANSI color escape sequence:
+
+ print $repo->get_color("color.interactive.prompt", "underline blue white");
+ print "some text";
+ print $repo->get_color("", "normal");
+
+=cut
+
+sub get_color {
+ my ($self, $slot, $default) = @_;
+ my $color = $self->command_oneline('config', '--get-color', $slot, $default);
+ if (!defined $color) {
+ $color = "";
+ }
+ return $color;
+}
=item ident ( TYPE | IDENTSTR )
"$name <$email>" eq ident_person($name);
$time_tz =~ /^\d+ [+-]\d{4}$/;
-Both methods must be called on a repository instance.
-
=cut
sub ident {
- my ($self, $type) = @_;
+ my ($self, $type) = _maybe_self(@_);
my $identstr;
if (lc $type eq lc 'committer' or lc $type eq lc 'author') {
- $identstr = $self->command_oneline('var', 'GIT_'.uc($type).'_IDENT');
+ my @cmd = ('var', 'GIT_'.uc($type).'_IDENT');
+ unshift @cmd, $self if $self;
+ $identstr = command_oneline(@cmd);
} else {
$identstr = $type;
}
}
sub ident_person {
- my ($self, @ident) = @_;
- $#ident == 0 and @ident = $self->ident($ident[0]);
+ my ($self, @ident) = _maybe_self(@_);
+ $#ident == 0 and @ident = $self ? $self->ident($ident[0]) : ident($ident[0]);
return "$ident[0] <$ident[1]>";
}
=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.
}
+=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 -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};
+}
=back
$self->wc_subdir() and chdir($self->wc_subdir());
}
_execv_git_cmd(@args);
- die "exec failed: $!";
+ die qq[exec "@args" failed: $!];
}
# Execute the given Git command ($_[0]) with arguments ($_[1..])
}
-sub DESTROY { }
+sub DESTROY {
+ my ($self) = @_;
+ $self->_close_hash_and_insert_object();
+ $self->_close_cat_blob();
+}
# Pipe implementation for ActiveState Perl.
if ($self->{i} >= scalar @{$self->{data}}) {
return undef;
}
- return $self->{'data'}->[ $self->{i}++ ];
+ my $i = $self->{i};
+ if (wantarray) {
+ $self->{i} = $#{$self->{'data'}} + 1;
+ return splice(@{$self->{'data'}}, $i);
+ }
+ $self->{i} = $i + 1;
+ return $self->{'data'}->[ $i ];
}
sub CLOSE {