File Coverage

blib/lib/VCS/Which/Plugin/Git.pm

Criterion	Covered	Total	%
statement	46	185	24.8
branch	10	68	14.7
condition	0	27	0.0
subroutine	12	24	50.0
pod	10	10	100.0
total	78	314	24.8

package VCS::Which::Plugin::Git;

# Created on: 2009-05-16 16:58:22
# Create by:  ivan
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use Moo;
use strict;
use warnings;
use version;
use Carp;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use Path::Tiny;
use File::chdir;
use Contextual::Return;

extends 'VCS::Which::Plugin';

our $VERSION = version->new('0.6.9');
our $name    = 'Git';
our $exe     = 'git';
our $meta    = '.git';

sub installed {
    my ($self) = @_;

    return $self->_installed if defined $self->_installed;

    for my $path (split /[:;]/, $ENV{PATH}) {
        next if !-x "$path/$exe";

        return $self->_installed( 1 );
    }

    return $self->_installed( 0 );
}

sub used {
    my ( $self, $dir ) = @_;

    if (-f $dir) {
        $dir = path($dir)->parent;
    }

    croak "$dir is not a directory!" if !-d $dir;

    my $current_dir = path($dir)->absolute;
    my $level       = 1;

    while ($current_dir) {
        if ( -d "$current_dir/$meta" ) {
            $self->_base( $current_dir );
            return $level;
        }

        $level++;

        # check that we still have a parent directory
        last if $current_dir eq $current_dir->parent;

        $current_dir = $current_dir->parent;
    }

    return 0;
}

sub uptodate {
    my ( $self, $dir ) = @_;

    $dir ||= $self->_base;

    croak "'$dir' is not a directory!" if !-d $dir;

    local $CWD = path($dir)->absolute;
    my $ans = `$exe status`;

    return $ans =~ /nothing \s to \s commit/xms ? 1 : 0;
}

sub pull {
    my ( $self, $dir ) = @_;

    $dir ||= $self->_base;

    croak "'$dir' is not a directory!" if !-e $dir;

    local $CWD = $dir;
    return !system "$exe pull > /dev/null 2> /dev/null";
}

sub push {
    my ( $self, $dir ) = @_;

    $dir ||= $self->_base;

    croak "'$dir' is not a directory!" if !-e $dir;

    local $CWD = $dir;
    return !system "$exe push origin master > /dev/null 2> /dev/null";
}

sub cat {
    my ($self, $file, $revision) = @_;

    # git expects $file to be relative to the base of the git repo not the
    # current directory so we change it to being relative to the repo if nessesary
    my $repo_dir = path($self->_base) or confess "How did I get here with out a base directory?\n";
    my $cwd      = path('.')->absolute;
    local $CWD = $CWD;

    if ( -f $file && $cwd ne $repo_dir ) {
        # get relavie directory of $cwd to $repo_dir
        my ($relative) = $cwd =~ m{^ $repo_dir / (.*) $}xms;
        my $old = $file;
        $file = path("$relative/$file");
        warn "Using repo absolute file $file from $old\n" if $ENV{VERBOSE};
        $CWD = $repo_dir;
    }

    if ( $revision && $revision =~ /^-?\d+$|[^0-9a-fA-F]/xms ) {
        eval { require Git };
        if ($EVAL_ERROR) {
            die "Git.pm is not installed only propper revision names can be used\n";
        }

        my $repo = Git->repository(Directory => $self->_base);
        my @revs = reverse $repo->command('log', '--format=format:%H', '--', $file);
        $revision = $revision =~ /^[-]?\d+$/xms && $revs[$revision] ? $revs[$revision] : $revision;
    }
    elsif ( !defined $revision ) {
        $revision = '';
    }
    warn "$exe show $revision\:$file\n" if $ENV{VERBOSE};

    return `$exe show $revision\:$file`;
}

sub log {
    my ($self, @args) = @_;
    local $CWD = $CWD;

    my $dir;
    if ( defined $args[0] && -d $args[0] && $args[0] =~ m{^/} ) {
        $dir = shift @args;
        $CWD = $dir;
    }
    my $args = join ' ', grep {defined $_} @args;

    return
        SCALAR   { scalar `$exe log $args` }
        ARRAYREF {
            my @raw_log = `$exe log $args`;
            my @log;
            my $line = '';
            for my $raw (@raw_log) {
                if ( $raw =~ /^commit / && $line ) {
                    CORE::push @log, $line;
                    $line = $raw;
                }
                else {
                    $line .= $raw;
                }

            }
            return \@log;
        }
        HASHREF  {
            my $logs = `$exe log $args`;
            my @logs = split /^commit\s*/xms, $logs;
            shift @logs;
            my $num = @logs;
            my %log;
            for my $log (@logs) {
                $log{$num--} = $self->_log_expand($log);
            }
            return \%log;
        }
}

sub _log_expand {
    my ($self, $log) = @_;

    # split the commit from the reset of the message
    my ($ver, $rest) = split /\n/, $log, 2;

    # split log details and the description
    my ($details, $description) = split /\n\n\s*/, $rest, 2;

    # remove excess whitespace at the end of the description
    $description =~ s/\s+\Z//xms;
    my ($conflicts) = $description =~ /\s+Conflicts:\s+(.*)\Z/xms;
    $description =~ s/\s+Conflicts:\s+(.*)\Z//xms;

    # split up the details
    my %log = map {split /:\s*/, $_, 2} split /\n/, $details;

    # add in the description
    $log{description} = $description;

    # add in the revision
    $log{rev} = $ver;

    # add conflicts if any
    $log{conflicts} = [ split /\n\s+/, $conflicts ] if $conflicts;

    return \%log;
}

sub versions {
    my ($self, $file, $oldest, $newest, $max) = @_;

    eval { require Git };
    if ($EVAL_ERROR) {
        die "Git.pm is not installed only propper revision names can be used\n";
    }

    my $repo = Git->repository(Directory => $self->_base);
    my @revs = reverse $repo->command('rev-list', '--all', '--', path($file)->absolute);

    return @revs;
}

sub status {
    my ($self, $dir) = @_;
    my %status;
    my $name = '';
    if ( -f $dir ) {
        $name = path($dir)->absolute->basename;
    }
    local $CWD = -f $dir ? path($dir)->absolute->parent : path($dir)->absolute;
    my $status = `$exe status $name`;
    $status =~ s/^no \s+ changes (.*?) $//xms;
    chomp $status;

    my @both = split /\n?[#]?\s+both\s+modified:\s+/, $status;
    if ( @both > 1 ) {
        shift @both;
        $both[-1] =~ s/\n.*//xms;
        $status{both} = \@both;
    }

    my @modified = split /\n?[#]?\s+modified:\s+/, $status;
    if ( @modified > 1 ) {
        shift @modified;
        $modified[-1] =~ s/\n.*//xms;
        $status{modified} = \@modified;
    }

    my @added = split /\n?[#]?\s+new\sfile:\s+/, $status;
    if ( @added > 1 ) {
        shift @added;
        $added[-1] =~ s/\n.*//xms;
        $status{added} = \@added;
    }

    my @committed = split /Changes to be committed:\n/, $status;
    if (@committed > 1) {
        my $new = pop @committed;
        $status{committed} = [ $new =~ /^\t[^:]+:\s+(.*?)\n/gxms ];
    }

    my @untracked = split /Untracked files:\n/, $status;
    if ( @untracked > 1 ) {
        my $untracked = pop @untracked;
        if ($untracked =~ s/^\s+[(]use \s+ "git \s+ add \s+ [^"]+" \s+ [^)]+\)\n\n//xms) {
            chomp $untracked;
        }
        else {
            $untracked =~ s/^[#].*?\n//gxms;
        }

        if ($untracked =~ /^[#]/xms) {
            $status{untracked} = [ grep {$_} map {chomp; $_} split /\n?[#]\s+/, $untracked ];
        }
        else {
            $status{untracked} = [ $untracked =~ /^\t(.*?)\n/gxms ];
        }
    }

    if ($status =~ /
        You \s+ have \s+ unmerged \s+ paths[.]$
        |
        All \s+ conflicts \s+ fixed \s+ but \s+ you \s+ are \s+ still \s+ merging[.]$
    /xms) {
        $status{merge} = 1;
    }

    return \%status;
}

sub checkout {
    my ($self, $dir, @extra) = @_;
    my $name = '';
    if ( -f $dir ) {
        $name = path($dir)->absolute->basename;
    }
    local $CWD = -f $dir ? path($dir)->absolute->parent : path($dir)->absolute;
    my $extra = join ' ', @extra;
    `$exe checkout $extra $name`;

    return;
}

1;

__END__