File Coverage

blib/lib/Git/Helpers.pm

Criterion	Covered	Total	%
statement	79	80	98.7
branch	9	10	90.0
condition	6	8	75.0
subroutine	23	23	100.0
pod	7	7	100.0
total	124	128	96.8

use strict;
use warnings;

package Git::Helpers;
our $VERSION = '0.000021';
use Carp qw( croak );
use Capture::Tiny 'capture_stderr';
use File::pushd qw( pushd );
use Git::Sub;
use Sub::Exporter -setup => {
    exports => [
        'checkout_root',
        'current_branch_name',
        'https_remote_url',
        'ignored_files',
        'is_inside_work_tree',
        'remote_url',
        'travis_url',
    ]
};
use Try::Tiny qw( catch try );
use URI ();
use URI::FromHash qw( uri );
use URI::Heuristic qw(uf_uristr);
use URI::git ();

sub checkout_root {
    my $dir = shift;

    my ( $new_dir, $root );
    $new_dir = pushd($dir) if $dir;
    $dir ||= '.';

    # the exception thrown by rev-parse when we're not in a repo is not
    # very helpful (see following), so just ditch it in favor of the error
    # output.
    #   "rev_parse error 128 at /home/maxmind/perl5/lib/perl5/Git/Helpers.pm line 30"

    my $stderr = capture_stderr {
        try { $root = scalar git::rev_parse qw(--show-toplevel) }
    };
    croak "Error in $dir: $stderr"
        if $stderr;

    return $root;
}

# Works as of 1.6.3:1
# http://stackoverflow.com/questions/1417957/show-just-the-current-branch-in-git
sub current_branch_name {
    return git::rev_parse( '--abbrev-ref', 'HEAD' );
}

sub https_remote_url {
    my $remote_url = remote_url(shift);
    return undef unless $remote_url;

    my $branch = shift;

    # remove trailing .git
    $remote_url =~ s{\.git\z}{};

    # remove 'git@' from [e-mail]:username/repo.git
    $remote_url =~ s{\w*\@}{};

    # remove : from [e-mail]:username/repo.git
    $remote_url =~ s{(\w):(\w)}{$1/$2};

    if ($branch) {
        $remote_url .= '/tree/' . current_branch_name();
    }

    my $uri = URI->new( uf_uristr($remote_url) );
    $uri->scheme('https');
    return $uri;
}

sub is_inside_work_tree {
    my $success;
    capture_stderr {
        try {
            $success = git::rev_parse('--is-inside-work-tree');
        };
    };
    return $success;
}

sub ignored_files {
    my $dir = shift || '.';
    my @success;
    my $stderr = capture_stderr {
        try {
            @success = git::ls_files(
                $dir, '--ignored', '--exclude-standard',
                '--others'
            );
        };
    };

    croak "Cannot find ignored files in dir: $stderr" if $stderr;

    return \@success || [];
}

sub remote_url {
    my $remote = shift || 'origin';
    my $url;
    my $stderr = capture_stderr {
        try {
            $url = git::remote( 'get-url', $remote );
        }

        catch {
            try {
                $url = git::config( '--get', "remote.$remote.url" );
            };
        }
    };

    return $url;
}

sub travis_url {
    my $remote_url = https_remote_url(shift);
    my $url        = URI->new($remote_url);
    return uri(
        scheme => 'https',
        host   => 'travis-ci.org',
        path   => $url->path,
    );
}

1;

#ABSTRACT: Shortcuts for common Git commands

__END__