File Coverage

blib/lib/Git/Repository.pm

Criterion	Covered	Total	%
statement	126	130	96.9
branch	64	64	100.0
condition	20	28	71.4
subroutine	25	27	92.5
pod	4	7	57.1
total	239	256	93.3

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

use Carp;
use File::Spec;
use Cwd qw( cwd realpath );

use Git::Repository::Command;
use Git::Version::Compare qw( :ops );

# helper function
sub _abs_path {
    my ( $path, $base ) = @_;
    my $abs_path = File::Spec->rel2abs( $path, $base );

    # normalize, but don't die on Win32 if the path doesn't exist
    eval { $abs_path = realpath($abs_path); };
    return $abs_path;
}

use namespace::clean;

# a few simple accessors
for my $attr (qw( git_dir work_tree options )) {
    no strict 'refs';
    *$attr = sub { return ref $_[0] ? $_[0]{$attr} : () };
}

# backward compatible aliases
sub repo_path {
    croak "repo_path() is obsolete, please use git_dir() instead";
}
sub wc_path {
    croak "wc_path() is obsolete, please use work_tree() instead";
}

#
# support for loading plugins
#
sub import {
    my ( $class, @plugins ) = @_;

    for my $plugin (@plugins) {
        ( $plugin, my @names ) = @$plugin if ref $plugin;
        $plugin
            = substr( $plugin, 0, 1 ) eq '+'
            ? substr( $plugin, 1 )
            : "Git::Repository::Plugin::$plugin";
        eval "use $plugin; 1;" or croak $@;
        $plugin->install(@names);
    }
}

#
# constructor-related methods
#

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

    # create the object
    my $self = bless {}, $class;

    # take out the option hash
    my ( $options, %arg );
    {
        my @o;
        %arg = grep !( ref eq 'HASH' ? push @o, $_ : 0 ), @arg;
        croak "Too many option hashes given: @o" if @o > 1;
        $options = $self->{options} = shift @o || {};
    }

    # ignore 'input' and 'fatal' options during object creation
    my $input = delete $options->{input};
    my $fatal = delete $options->{fatal};

    # die if deprecated parameters are given
    croak "repository is obsolete, please use git_dir instead"
        if defined delete $arg{repository};
    croak "working_copy is obsolete, please use work_tree instead"
        if defined delete $arg{working_copy};

    # setup default options
    my $git_dir   = delete $arg{git_dir};
    my $work_tree = delete $arg{work_tree};

    croak "Unknown parameters: @{[keys %arg]}" if keys %arg;

    # compute the various paths
    my $cwd = defined $options->{cwd} ? $options->{cwd} : cwd();

    # if work_tree or git_dir are relative, they are relative to cwd
    -d ( $git_dir = _abs_path( $git_dir, $cwd ) )
        or croak "directory not found: $git_dir"
        if defined $git_dir;
    -d ( $work_tree = _abs_path( $work_tree, $cwd ) )
        or croak "directory not found: $work_tree"
        if defined $work_tree;

    # if no cwd option given, assume we want to work in work_tree
    $cwd = defined $options->{cwd} ? $options->{cwd}
         : defined $work_tree      ? $work_tree
         :                           cwd();

    # we'll always have to compute it if not defined
    $self->{git_dir} = _abs_path(
        Git::Repository->run(
            qw( rev-parse --git-dir ),
            { %$options, cwd => $cwd }
        ),
        $cwd
    ) if !defined $git_dir;

    # there are 4 possible cases
    if ( !defined $work_tree ) {

        # 1) no path defined: trust git with the values
        # $self->{git_dir} already computed

        # 2) only git_dir was given: trust it
        $self->{git_dir} = $git_dir if defined $git_dir;

        # in a non-bare repository, the work tree is just above the gitdir
        if ( $self->run(qw( config --bool core.bare )) ne 'true' ) {
            $self->{work_tree}
                = _abs_path( File::Spec->updir, $self->{git_dir} );
        }
    }
    else {

        # 3) only work_tree defined:
        if ( !defined $git_dir ) {

            # $self->{git_dir} already computed

            # check work_tree is the top-level work tree, and not a subdir
            my $cdup = Git::Repository->run( qw( rev-parse --show-cdup ),
                { %$options, cwd => $cwd } );
            $self->{work_tree}
                = $cdup ? _abs_path( $cdup, $work_tree ) : $work_tree;
        }

        # 4) both path defined: trust the values
        else {
            $self->{git_dir}   = $git_dir;
            $self->{work_tree} = $work_tree;
        }
    }

    # sanity check
    my $gitdir
        = eval { _abs_path( $self->run(qw( rev-parse --git-dir )), $cwd ) }
        || '';
    croak "fatal: not a git repository: $self->{git_dir}"
        if $self->{git_dir} ne $gitdir;

    # put back the ignored options
    $options->{input} = $input if defined $input;
    $options->{fatal} = $fatal if defined $fatal;

    return $self;
}

# create() is now fully deprecated
sub create {
    croak "create() is deprecated, see Git::Repository::Tutorial for better alternatives";
}

#
# command-related methods
#

# return a Git::Repository::Command object
sub command {
    shift @_ if !ref $_[0];    # remove class name if called as class method
    return Git::Repository::Command->new(@_);
}

# run a command, returns the output
# die with errput if any
sub run {
    my ( $self, @cmd ) = @_;

    # split the args to get the optional callbacks
    my @cb;
    @cmd = grep { ref eq 'CODE' ? !push @cb, $_ : 1 } @cmd;

    local $Carp::CarpLevel = 1;

    # run the command (pass the instance if called as an instance method)
    my $command
        = Git::Repository::Command->new( ref $self ? $self : (), @cmd );

    # return the output or die
    return $command->final_output(@cb);
}

#
# version comparison methods
#

# NOTE: it doesn't make sense to try to cache the results of version():
# - yes, it will make faster benchmarks, but
# - the 'git' option allows to change the git binary anytime
# - version comparison is usually done once anyway
sub version {
    return (
        shift->run( '--version', grep { ref eq 'HASH' } @_ )
            =~ /git version (.*)/g )[0];
}

BEGIN {
    for my $op ( qw( lt gt le ge eq ne ) ) {
        no strict 'refs';
        *{"version_$op"} = eval << "OP";
sub {
    my \$r = shift;
    my \@o;
    my (\$v) = grep !( ref && ref eq 'HASH' ? push \@o, \$_ : 0 ), \@_;
    return ${op}_git( \$r->version(\@o), \$v );
}
OP
    }
}

1;

__END__