File Coverage

blib/lib/Git/Archive.pm

Criterion	Covered	Total	%
statement	99	114	86.8
branch	41	52	78.8
condition	10	12	83.3
subroutine	9	10	90.0
pod	1	1	100.0
total	160	189	84.6

package Git::Archive;

use strict;
use v5.10.0;
our $VERSION = '0.10';
use IPC::Cmd qw/can_run/;

use Git::Repository;

sub commit {
    my $self = shift;
    # Get passed-in arguments correctly into hash
    my $args = ref $_[0] eq 'HASH' ? shift @_ : {@_};

    # Check for mandatory args
    ## First, make sure we have an error sub defined
    my $error =  $args->{error}
              || sub {
                  my ($args, $error) = @_;
                  print STDERR "[ERROR] $error\n";
                  return 1;
                  };

    ## Now throw errors if necessary
    unless ( $args->{msg} ) {
        return $error->( $args,'No commit message supplied');
        }
    unless ( $args->{files} || $args->{all_tracked} || $args->{all_dirty} ) {
        return $error->( $args,'No files specified to commit');
        }
    unless ( can_run( 'git' ) ) {
        return $error->( $args,'Git does not appear to be installed');
        }

    # Seems all is well with args. Check if the environment is sane
    ## Is the current or passed-in directory a git repo?
    my $repo = $self->_get_repo( $args );
    unless ( $repo ) { return $error->( $args, $args->{error} ) }

    ## Are there files already staged?
    if ( $repo->run( qw/diff --cached --name-only/ ) ) {
        return $error->( $args,'Repo already has staged files');
        }

    ## Populate name & email if not already done
    unless ( $repo->run( 'config', 'user.email' ) ) {
        system( $repo->run( 'config', 'user.email', '"[e-mail]"' ) );
        }
    unless ( $repo->run( 'config', 'user.name' ) ) {
        system( $repo->run( 'config', 'user.name', '"Automated Commit"' ) );
        }

    # Looks like we're good to go. Let's commit!
    my $files = $self->_commit( $args, $repo ) || [];
    unless ( @{$files} ) {
        return $error->( $args, $args->{error} );
        }
    # We've got a new commit. Do we need to worry about a remote?
    my $do_remote;
    $do_remote = $self->_handle_remote( $args, $repo ) if $args->{use_remote};
    return $error->( $args, $args->{error} ) if $do_remote;;

    # Looks like we made it! Run the success sub if appropriate
    $args->{success}->( $args ) if $args->{success};

    return 0;
    }

sub _filenames {
    my ( $self, $args ) = @_;

    unless ( ref $args->{files} eq 'ARRAY' ) {
        my $files = $args->{files};
        $files =~ s/\s+/ /;
        return [ split ' ', $files ];
        }
    return $args->{files};
    }

sub _get_repo {
    my ($self, $args) = @_;
    $args->{git_dir} ||= './';
    unless (-e $args->{git_dir}) {
        $args->{error} = "Unable to initialise git directory:\nNo such directory";
        return;
        }
    unless (-e $args->{git_dir}.'/.git') {
        $args->{error} = "Unable to initialise git directory:\nNo .git found";
        return;
        }
    my $repo;
    my $options = {};
    if ( my $sudo = $args->{sudo} ) {
        $options = { git => [ 'sudo', '-u', $args->{sudo}, 'git' ] };
        }
    eval { $repo = Git::Repository->new( work_tree => $args->{git_dir}, $options ); };
    unless ($@) {
        return $repo;
        }
    $args->{error} = "Unable to initialise git directory:\n" . $@;
    return;
    }

sub _commit {
    my ($self, $args, $repo) = @_;

    my $files; # To record what files we intend to commit

    if ( $args->{files} ) {
        ## We have a list of specified files to commit
        $files = $self->_filenames( $args );
        eval { $repo->run( 'add', @{$files} ); };
        ## Do we need to make sure all the files had changes to stage?
        if ( $args->{check_all_staged} ) {
            my @staged = $repo->run( qw/diff --cached --name-only/ );
            unless ( @staged == @{$files} ) {
                # Numerical equality is Good Enough for now
                $repo->run( reset => 'HEAD' ); # Unstage the files, it's all gone wrong!
                $args->{error} = 'Some files not staged when "check_all_staged" specified';
                return;
                }
            }
        # Files staged and ready to go. Commit time
        $repo->run( commit => '-m "' . $args->{msg} . '"' );
        }
    elsif ( $args->{all_tracked} ) {
        ## We want to commit any modified tracked files
        my @status = $repo->run( status => '-s' );
        my @staged;
        unless ( @staged = grep { $_ !~ m/^\?\?/ } @status ) {
            $args->{error} = 'No modified files to commit';
            return;
            }
        $files = [map { $_ =~ s/^\s*\S+\s+(\S+)/$1/ } @staged];
        $repo->run( commit => '-a', '-m "' . $args->{msg} . '"' );
        }
    elsif ( $args->{all_dirty} ) {
        ## We want to commit all files in their current state
        my @status = $repo->run( status => '-s' );
        unless ( @status ) {
            $args->{error} = 'No modified files to commit';
            return;
            }
        $files = [map { $_ =~ s/^\s*\S+\s+(\S+)/$1/; $_ } @status];
        eval { $repo->run( 'add', @{$files} ); };
        $repo->run( commit => '-m "' . $args->{msg} . '"' );
        }

    return $files;
    }

sub _handle_remote {
    my ($self, $args, $repo) = @_;
    # We have a commit. Hopefully, the remote repo has nothing we don't.
    # But since it may well have, we need to:
    # Pull, and hope it doesn't fail
    # Then push, and hope it doesn't fail
    my $remote = $args->{use_remote};
    my $pull = $repo->run( pull => $remote );
    if ( $pull =~ /Automatic merge failed/ ) {
        # Damn, the pull didn't work.
        # Quick, pretend it never happened!
        $repo->run( merge => '--abort' );
        # Actually, we should probably 'fess up
        $args->{error} = 'Unable to push to remote: Cannot pull';
        return 1;
        }
    # Ok, we managed a pull. Hopefully we can now push
    my $push = $repo->run( push => $remote );
    if ( $push =~ /\[rejected\]/ ) {
        # We failed. Maybe somebody managed to push?
        # (in the tiny amount of time they had to work with)
        # Possibly we should try to push multiple times, but CBA -
        # "fail once, shout for help" seems far saner.
        $args->{error} = 'Unable to push to remote: Rejected';
        return 1;
        }
    return;
    }

1;

__END__