File Coverage

blib/lib/Git/Repository/Command.pm

Criterion	Covered	Total	%
statement	91	91	100.0
branch	56	58	96.5
condition	25	32	78.1
subroutine	19	19	100.0
pod	2	2	100.0
total	193	202	95.5

package Git::Repository::Command;
$Git::Repository::Command::VERSION = '1.324';
use strict;
use warnings;
use 5.006;

use Carp;
use Cwd qw( cwd );
use IO::Handle;
use Scalar::Util qw( blessed );
use File::Spec;
use System::Command;

our @ISA = qw( System::Command );

# a few simple accessors
for my $attr (qw( pid stdin stdout stderr exit signal core )) {
    no strict 'refs';
    *$attr = sub { return $_[0]{$attr} };
}
for my $attr (qw( cmdline )) {
    no strict 'refs';
    *$attr = sub { return @{ $_[0]{$attr} } };
}

sub _which {
    my @pathext = ('');
    push @pathext,
        $^O eq 'MSWin32' ? split ';', $ENV{PATHEXT}
      : $^O eq 'cygwin'  ? qw( .com .exe .bat )
      :                    ();

    for my $path ( File::Spec->path ) {
        for my $ext (@pathext) {
            my $binary = File::Spec->catfile( $path, $_[0] . $ext );
            return $binary if -x $binary && !-d _;
        }
    }

    # not found
    return undef;
}

# CAN I HAS GIT?
my %binary;    # cache calls to _is_git
sub _is_git {
    my ( $binary, @args ) = @_;
    my $args = join "\0", @args;

    # git option might be an arrayref containing an executable with arguments
    # Best that can be done is to check if the first part is executable
    # and use the arguments as part of the cache key

    # compute cache key:
    # - filename (path-rel): $CWD \0 $PATH
    # - filename (path):     $PATH
    # - absolute path (abs): empty string
    # - relative path (rel): dirname
    my $path = defined $ENV{PATH} && length( $ENV{PATH} ) ? $ENV{PATH} : '';
    my ( $type, $key ) =
        ( File::Spec->splitpath($binary) )[2] eq $binary
      ? grep( !File::Spec->file_name_is_absolute($_), File::Spec->path )
          ? ( 'path-rel', join "\0", cwd(), $path )
          : ( 'path', $path )
      : File::Spec->file_name_is_absolute($binary) ? ( 'abs', '' )
      :                                              ( 'rel', cwd() );

    # This relatively complex cache key scheme allows PATH or cwd to change
    # during the life of a program using Git::Repository, which is likely
    # to happen. On the other hand, it completely ignores the possibility
    # that any part of the cached path to a git binary could be a symlink
    # which target may also change during the life of the program.

    # check the cache
    return $binary{$type}{$key}{$binary}{$args}
        if exists $binary{$type}{$key}{$binary}{$args};

    # compute a list of candidate files (look in PATH if needed)
    my $git = $type =~ /^path/
      ? _which($binary)
      : File::Spec->rel2abs($binary);
    $git = File::Spec->rel2abs($git)
      if defined $git && $type eq 'path-rel';

    # if we can't find any, we're done
    return $binary{$type}{$key}{$binary} = undef
        if !( defined $git && -x $git );

    # try to run it
    my $cmd = System::Command->new( $git, @args, '--version' );
    my $version = do { local $/ = "\n"; $cmd->stdout->getline; } || '';
    $cmd->close;

    # does it really look like git?
    return $binary{$type}{$key}{$binary}{$args}
        = $version =~ /^git version \d/
            ? $type eq 'path'
                ? $binary    # leave the shell figure it out itself too
                : $git
            : undef;
}

sub new {
    my ( $class, @cmd ) = @_;

    # split the args
    my (@r, @o);
    @cmd =    # take out the first Git::Repository in $r, and options in @o
        grep !( blessed $_ && $_->isa('Git::Repository') ? push @r, $_ : 0 ),
        grep !( ref eq 'HASH'                            ? push @o, $_ : 0 ),
        @cmd;

    # wouldn't know what to do with more than one Git::Repository object
    croak "Too many Git::Repository objects given: @r" if @r > 1;
    my $r = shift @r;

    # keep changes to the environment local
    local %ENV = %ENV;

    # a Git::Repository object will give more context
    if ($r) {

        # pick up repository options
        unshift @o, $r->options;

        # get some useful paths
        my ( $git_dir, $work_tree ) = ( $r->git_dir, $r->work_tree );
        unshift @o, { cwd => $work_tree }
            if defined $work_tree && length $work_tree;

        # setup our %ENV
        delete @ENV{qw( GIT_DIR GIT_WORK_TREE )};
        $ENV{GIT_DIR}       = $git_dir;
        $ENV{GIT_WORK_TREE} = $work_tree
            if defined $work_tree;
    }

    # pick up the modified PATH, if any
    exists $_->{env} and exists $_->{env}{PATH} and $ENV{PATH} = $_->{env}{PATH}
      for @o;

    # extract and process the 'fatal' option
    push @o, {
        fatal => {
            128 => 1,    # fatal
            129 => 1,    # usage
            map s/^-// ? ( $_ => '' ) : ( $_ => 1 ),
            map /^!0$/ ? ( 1 .. 255 ) : $_,
            map ref() ? @$_ : $_, grep defined, map $_->{fatal}, @o
        }
    };

    # get and check the git command
    my $git_cmd = ( map { exists $_->{git} ? $_->{git} : () } @o )[-1];

    # git option might be an arrayref containing an executable with arguments
    # (e.g. [ qw( /usr/bin/sudo -u nobody git ) ] )
    ( $git_cmd, my @args )
        = defined $git_cmd ? ref $git_cmd ? @$git_cmd : ($git_cmd) : ('git');
    my $git = _is_git($git_cmd, @args);

    croak sprintf "git binary '%s' not available or broken",
        join( ' ', $git_cmd, @args )    # show the full command given
        if !defined $git;

    # turn us into a dumb terminal
    delete $ENV{TERM};

    # spawn the command and re-bless the object in our class
    return bless System::Command->new( $git, @args, @cmd, @o ), $class;
}

sub final_output {
    my ($self, @cb) = @_;

    # get output / errput
    my ( @output, @errput );
    $self->loop_on(
        input_record_separator => "\n",
        stdout => sub { chomp( my $o = shift ); push @output, $o; },
        stderr => sub { chomp( my $e = shift ); push @errput, $e; },
    );

    # done with it
    $self->close;

    # fatal exit codes set by the 'fatal' option
    # when working with fatal => '!0' it's helpful to be able to show the exit status
    # so that specific exit codes can be made non-fatal if desired.
    if ( $self->options->{fatal}{ $self->exit } ) {
        croak join( "\n", @errput ) || 'fatal: unknown git error, exit status '.$self->exit;
    }

    # something else's wrong
    if ( @errput && !$self->options->{quiet} ) { carp join "\n", @errput; }

    # process the output with the optional callbacks
    for my $cb (@cb) {
        @output = map $cb->($_), @output;
    }

    # return the output
    return wantarray ? @output : join "\n", @output;
}

1;

__END__