The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;
use Test::Git;
use File::Temp qw( tempdir );
use File::Spec;
use Cwd qw( cwd abs_path );
use Git::Repository;

has_git( '1.5.5' );

my $version = Git::Repository->version;

plan tests => my $tests;

# clean up the environment
delete @ENV{qw( GIT_DIR GIT_WORK_TREE )};
$ENV{LC_ALL}              = 'C';
$ENV{GIT_AUTHOR_NAME}     = 'Test Author';
$ENV{GIT_AUTHOR_EMAIL}    = 'test.author@example.com';
$ENV{GIT_COMMITTER_NAME}  = 'Test Committer';
$ENV{GIT_COMMITTER_EMAIL} = 'test.committer@example.com';
my $home = cwd;

local $/ = chr rand 128;

# small helper sub
sub update_file {
    my ( $file, $content ) = @_;
    open my $fh, '>', $file or die "Can't open $file: $!";
    print {$fh} $content;
    close $fh;
}

# a place to put a git repository
my $dir = abs_path( tempdir( CLEANUP => 1 ) );

# PASS - non-existent directory
BEGIN { $tests += 3 }
chdir $dir;
Git::Repository->run('init');
my $r = Git::Repository->new();
isa_ok( $r, 'Git::Repository' );
chdir $home;

is( $r->work_tree, $dir, 'work tree' );

my $gitdir = $r->run( qw( rev-parse --git-dir ) );
$gitdir = File::Spec->catfile( $dir, $gitdir )
    if ! File::Spec->file_name_is_absolute( $gitdir );
is( $gitdir, $r->git_dir, 'git-dir' );

# check usage exit code
BEGIN { $tests += 2 }
ok( ! eval { $r->run( qw( commit --bonk ) ); }, "FAIL with usage text" );
like( $@, qr/^usage: .*?git[- ]commit/m, '... expected usage message' );

# add file to the index
update_file( File::Spec->catfile( $dir, 'readme.txt' ), << 'TXT' );
Some readme text
for our example
TXT

$r->run( add => 'readme.txt' );

# unset all editors
delete @ENV{qw( EDITOR VISUAL GIT_EDITOR )};

SKIP: {
    BEGIN { $tests += 2 }
    skip "these tests require git >= 1.6.6, but we only have $version", 2
        if Git::Repository->version_lt('1.6.6');

    skip "editor defined directly in .gitconfig", 2
        if $r->run( config => 'core.editor' );

    skip "this test does not work with msysgit on Win32", 2
        if $^O eq 'MSWin32';

    ok( !eval { $r->run( var => 'GIT_EDITOR' ); 1; }, 'git var GIT_EDITOR' );
    like(
        $@,
        qr/^fatal: Terminal is dumb, but EDITOR unset /,
        'Git complains about lack of smarts and editor'
    );
}

# with git commit it's not fatal
BEGIN { $tests += 4 }
SKIP: {
    skip "editor defined directly in .gitconfig", 4
        if $r->run( config => 'core.editor' );

    skip "this test does not work with msysgit on Win32", 4
        if $^O eq 'MSWin32';

    ok( my $cmd = $r->command('commit'), 'git commit' );
    isa_ok( $cmd, 'Git::Repository::Command' );
    local $/ = "\n";
    my $error = $cmd->stderr->getline;
    is_deeply( [ $cmd->cmdline ], [ qw( git commit ) ], 'command-line' );
    $cmd->close;
    like(
        $error,
        qr/^(?:error: )?Terminal is dumb/,
        'Git complains about lack of smarts and editor'
    );
}

# commit again
BEGIN { $tests += 1 }
my $message = 'a readme file';
$r->run( commit => '-m', $message );

my @log = $r->run( log => '--pretty=format:%s' );
is_deeply( \@log, [$message], 'git commit ; git log' );

# test callbacks
BEGIN { $tests += 2 }
@log = $r->run( log => '--pretty=format:%s', sub { ~~ reverse } );
is_deeply( \@log, [ ~~ reverse $message ], 'run() with 1 callback' );

sub rot13 { $_[0] =~ y/a-z/n-za-m/; $_[0] }
@log = $r->run( log => '--pretty=format:%s', \&rot13, sub { ~~ reverse } );
is_deeply( \@log, [ ~~ reverse rot13 $message ], 'run() with 2 callback' );

# use commit-tree with input option
BEGIN { $tests += 4 }
my $parent = $r->run( log => '--pretty=format:%H' );
like( $parent, qr/^[a-f0-9]{40}$/, 'parent commit id' );
my $tree = $r->run( log => '--pretty=format:%T' );
like( $parent, qr/^[a-f0-9]{40}$/, 'parent tree id' );

my $commit;
$commit = $r->run(
    'commit-tree' => $tree,
    '-p',
    $parent,
    { input => "$message $tree" },
);
like( $commit, qr/^[a-f0-9]{40}$/, 'new commit id' );
cmp_ok( $commit, 'ne', $parent, 'new commit id is different from parent id' );
$r->run( reset => $commit );

# process "long" output
BEGIN { $tests += 3 }
{
    my $lines;
    my $cmd = $r->command( log => '--pretty=oneline', '--all' );
    isa_ok( $cmd, 'Git::Repository::Command' );
    is_deeply( [ $cmd->cmdline ], [ qw( git log --pretty=oneline --all ) ], 'command-line' );
    my $log = $cmd->stdout;
    local $/ = "\n";
    while (<$log>) {
        $lines++;
    }
    is( $lines, 2, 'git log' );

    # no call to close, we count on DESTROY
}

# use command as a class method, with cwd option
BEGIN { $tests += 2 }
{
    my $cmd = Git::Repository->command(
        { cwd => $dir },
        log => '-1',
        '--pretty=format:%H'
    );
    isa_ok( $cmd, 'Git::Repository::Command' );
    local $/ = "\n";
    my $line = $cmd->stdout->getline();
    chomp $line;
    is( $line, $commit, 'git log -1' );
}

# use command as a class method, with env option
BEGIN { $tests += 2 }
{
    my $cmd = Git::Repository->command(
        { env => { GIT_DIR => $gitdir } },
        log => '-1',
        '--pretty=format:%H'
    );
    isa_ok( $cmd, 'Git::Repository::Command' );
    local $/ = "\n";
    my $line = $cmd->stdout->getline();
    chomp $line;
    is( $line, $commit, 'git log -1' );
    $cmd->stdout->close;
    $cmd->stderr->close;
}

# FAIL - run a command in a non-existent directory
BEGIN { $tests += 2 }
ok( !eval {
        $r->run(
            log => '-1',
            { cwd => File::Spec->catdir( $dir, 'not-there' ) },
            bless( {}, 'Foo' )    # will be ignored silently
        );
    },
    'Fail with option { cwd => non-existent dir }'
);
like( $@, qr/^Can't chdir to .*not-there/, '... expected error message' );

# FAIL - pass more than one Git::Repository to Git::Repository::Command
BEGIN { $tests += 2 }
ok( !eval {
        $r->run( 'version',
            bless( { work_tree => 'TEH FAIL' }, 'Git::Repository' ) );
    },
    'Fail with more than one Git::Repository object'
);
like(
    $@,
    qr/^Too many Git::Repository objects given: /,
    '... expected error message'
);

# now work with GIT_DIR and GIT_WORK_TREE only
BEGIN { $tests += 1 }
{
    local %ENV = %ENV;
    $ENV{GIT_DIR} = $gitdir;

    my $got = Git::Repository->run( log => '-1', '--pretty=format:%H' );
    is( $got, $commit, 'git log -1' );
}

# PASS - try with a relative dir
BEGIN { $tests += 3 }
chdir $dir;
$r = Git::Repository->new( work_tree => '.' );
isa_ok( $r, 'Git::Repository' );
chdir $home;

is( $r->work_tree, $dir, 'work tree' );
is( $r->git_dir, $gitdir, 'git dir' );

# PASS - try with a no dir
BEGIN { $tests += 3 }
chdir $dir;
$r = Git::Repository->new();
isa_ok( $r, 'Git::Repository' );
chdir $home;

is( $r->work_tree,   $dir,    'work tree' );
is( $r->git_dir, $gitdir, 'git dir' );

# PASS - pass the git binary as an option to new()
BEGIN { $tests += 9 }
{
    my $path_sep = $Config::Config{path_sep} || ';';
    my $re = qr/\Q$path_sep\E/;
    my @ext =
      ( '', $^O eq 'MSWin32' ? ( split $re, $ENV{PATHEXT} ) : () );
    my ($abs_git) = grep { -x && !-d }
      map {
        my $path = $_;
        map { File::Spec->catfile( $path, $_ ) } map { "git$_" } @ext
      } split $re, ( $ENV{PATH} || '' );

    # do not wipe the Windows PATH
    local $ENV{PATH} = join $path_sep,
        $^O eq 'MSWin32'
        ? grep { /\Q$ENV{SYSTEMROOT}\E/ }              split $re, $ENV{PATH}
        : grep { -x File::Spec->catfile( $_, 'pwd' ) } split $re, $ENV{PATH};

    $r = Git::Repository->new( git_dir => $gitdir, { git => $abs_git } );
    isa_ok( $r, 'Git::Repository' );
    is( $r->work_tree, $dir,    'work tree (git_dir, no PATH, git option)' );
    is( $r->git_dir,   $gitdir, 'git dir (git_dir, no PATH, git option)' );

    $r = Git::Repository->new( work_tree => $dir, { git => $abs_git } );
    isa_ok( $r, 'Git::Repository' );
    is( $r->work_tree, $dir, 'work tree (work_tree, no PATH, git option)' );
    is( $r->git_dir, $gitdir, 'git dir (work_tree, no PATH, git option)' );

    chdir $dir;
    $r = Git::Repository->new( { git => $abs_git } );
    isa_ok( $r, 'Git::Repository' );
    chdir $home;
    is( $r->work_tree, $dir,    'work tree (no PATH, git option)' );
    is( $r->git_dir,   $gitdir, 'git dir (no PATH, git option)' );
}

# PASS - use an option HASH
BEGIN { $tests += 3 }
is( Git::Repository->options(), undef, 'No options on the class' );
$r = Git::Repository->new(
    work_tree => $dir,
    {   env => {
            GIT_AUTHOR_NAME  => 'Example author',
            GIT_AUTHOR_EMAIL => 'author@example.com'
        }
    },
);
update_file( my $file = File::Spec->catfile( $dir, 'other.txt' ), << 'TXT' );
Some other text
forcing an author
TXT
$r->run( add => $file );
$r->run( commit => '-m', 'Test option hash in new()' );
my ($author) = grep {/^Author:/} $r->run( log => '-1', '--pretty=medium' );
is( $author,
    'Author: Example author <author@example.com>',
    'Option hash in new()'
);

update_file( $file, << 'TXT' );
Some other text
forcing another author
TXT
$r->run(
    commit => '-a',
    '-m', 'Test option hash in run()',
    { env => { GIT_AUTHOR_EMAIL => 'fail@fail.com' } },      # ignored silently
    { env => { GIT_AUTHOR_EMAIL => 'example@author.com' } }  # not ignored
);
($author) = grep {/^Author:/} $r->run( log => '-1', '--pretty=medium' );
is( $author,
    'Author: Example author <example@author.com>',
    'Option hash in new() and run()'
);

# FAIL - use more than one option HASH
BEGIN { $tests += 2 }
ok( !eval {
        $r = Git::Repository->new(
            work_tree => $dir,
            { env => { GIT_AUTHOR_NAME => 'Example author' } },
            { git => '/bin/false' }
        );
    },
    'new() dies when given more than one option HASH'
);
like( $@, qr/^Too many option hashes given: /, '... expected error message' );

# PASS - use an option HASH (no env key)
BEGIN { $tests += 2 }
( $parent, $tree ) = split /-/, $r->run( log => '--pretty=format:%H-%T', -1 );
ok( $r = eval {
        Git::Repository->new(
            work_tree => $dir,
            { input => 'a dumb way to set log message' },
        );
    },
    'Git::Repository->new()'
);

$commit = $r->run( 'commit-tree', $tree, '-p', $parent );
my $log = $r->run( log => '--pretty=format:%s', -1, $commit, { input => undef } );
is( $log, 'a dumb way to set log message', 'Option hash in new() worked' );

# PASS - create the empty tree
BEGIN { $tests += 2 }
ok( $r = eval { Git::Repository->new( work_tree => $dir ) },
    'Git::Repository->new()' );
$tree = $r->run( mktree => { input => '' } );
is( $tree, '4b825dc642cb6eb9a060e54bf8d69288fbee4904', 'mktree empty tree' );