The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
## no critic (RequireExplicitPackage)
## no critic (ErrorHandling::RequireCarping)
use 5.010;
use strict;
use warnings;
use Config;
use Path::Tiny;
use File::pushd;
use URI::file;
use Git::More;
use Error ':try';

# Make sure the git messages come in English.
local $ENV{LC_ALL} = 'C';

# The Gerrit hooks tests need to interact with a real Gerrit server
# running in the same host. Thus, we need some basic information which
# must be included in a file called GERRIT_CONFIG in the same
# directory as this file. The file is run as a Perl script and it must
# return a hash-ref like this:
#
# {
#   url        => 'http://localhost:8080',
#   username   => 'user',
#   password   => 'U-kant-no-dis',
#   hooks_dir  => '/path/to/testsite/hooks',
#   repo_dir   => '/path/to/testsite/git/test.git',
#   repo_url   => 'http://localhost:8080/test',
#   branch     => 'master',
#   file       => 'file.txt',
# };
#
# The meaning of each key is the following:
#
# * url, username, password: These values are used to construct a
#   Gerrit::REST object to interact with the Gerrit server via its
#   REST API.
#
# * hooks_dir: the directory where Gerrit hooks are kept. Note that
#   during the tests some hooks will be set up on this directory,
#   unless they are already existing. You may want to get rid of them
#   after the tests.
#
# * repo_dir: the root directory of Gerrit's git repository that will
#   be used for testing.
#
# * repo_url: Gerrit's repository URL which will be used to clone it.
#
# * branch: The branch in which commits will be created and from which
#   they'll be pushed for review.
#
# * file: The (base)name of a file that will be modified during the
#   tests in order to make commits.
#
# Note that the "git push" that's used to send a commit for review has
# to work without dealing with passwords. You should take care of this
# in the usual ways, like using an ssh-agent daemon or by configuring
# your ~/.netrc file.

my $gerrit_config = do {
    my $file = catfile(qw/t GERRIT_CONFIG/);
    if (-r $file) {
        my $config = do $file;
        unless ($config) {
            die "couldn't parse '$file': $@\n" if $@;
            die "couldn't run '$file'\n"       unless $config;
        }
        foreach my $key (qw/url username password hooks_dir repo_dir repo_url branch file/) {
            die "missing '$key' key in $file\n" unless exists $config->{key};
        }
        eval {require Gerrit::REST}
            or die "Can't require Gerrit::REST to perform Gerrit tests as configured in $file.\n";
        $config;
    } else {
        undef;
    }
};

# It's better to perform all tests in a temporary directory because
# otherwise the author runs the risk of messing with its local
# Git::Hooks git repository.

our $T = Path::Tiny->tempdir(
    TEMPLATE => 'githooks.XXXXX',
    TMPDIR   => 1,
    CLEANUP  => exists $ENV{REPO_CLEANUP} ? $ENV{REPO_CLEANUP} : 1,
);
use Cwd; my $cwd = path(cwd);
chdir $T or die "Can't chdir $T: $!";
END { chdir '/' }

my $tmpldir = $T->child('templates');
mkdir $tmpldir, 0777 or BAIL_OUT("can't mkdir $tmpldir: $!");
{
    my $hooksdir = $tmpldir->child('hooks');
    mkdir $hooksdir, 0777 or BAIL_OUT("can't mkdir $hooksdir: $!");
}

my $git_version;
try {
    $git_version = Git::command_oneline('version');
} otherwise {
    $git_version = 'unknown';
};

sub newdir {
    my $num = 1 + Test::Builder->new()->current_test();
    my $dir = $T->child($num);
    mkdir $dir;
    return $dir;
}

sub install_hooks {
    my ($git, $extra_perl, @hooks) = @_;
    my $hooks_dir = path($git->repo_path())->child('hooks');
    my $hook_pl   = $hooks_dir->child('hook.pl');
    {
        ## no critic (RequireBriefOpen)
        open my $fh, '>', $hook_pl or BAIL_OUT("Can't create $hook_pl: $!");
        state $debug = $ENV{DBG} ? '-d' : '';
        state $bliblib = $cwd->child('blib', 'lib');
        print $fh <<"EOF";
#!$Config{perlpath} $debug
use strict;
use warnings;
use lib '$bliblib';
EOF

        state $pathsep = $^O eq 'MSWin32' ? ';' : ':';
        if (defined $ENV{PERL5LIB} and length $ENV{PERL5LIB}) {
            foreach my $path (reverse split "$pathsep", $ENV{PERL5LIB}) {
                say $fh "use lib '$path';" if $path;
            }
        }

        print $fh <<'EOF';
use Git::Hooks;
EOF

        print $fh $extra_perl if defined $extra_perl;

        # Not all hooks defined the GIT_DIR environment variable
        # (e.g., pre-rebase doesn't).
        print $fh <<"EOF";
\$ENV{GIT_DIR}    = '.git' unless exists \$ENV{GIT_DIR};
\$ENV{GIT_CONFIG} = "\$ENV{GIT_DIR}/config";
EOF

        # Reset HOME to avoid reading ~/.gitconfig
        print $fh <<"EOF";
\$ENV{HOME}       = '';
EOF

        # Hooks on Windows are invoked indirectly.
        if ($^O eq 'MSWin32') {
            print $fh <<"EOF";
my \$hook = shift;
run_hook(\$hook, \@ARGV);
EOF
        } else {
            print $fh <<"EOF";
run_hook(\$0, \@ARGV);
EOF
        }
    }
<<<<<<< 2ff299c5331ec26e09b9648d17995387e5f5cfd0
    chmod 0755 => $hook_pl;
||||||| merged common ancestors
	    chmod 0755 => $hook_pl;
=======
    chmod 0755 => $hook_pl;

    my %gerrit_hooks = ('ref-update' => undef, 'patchset-created' => undef);
>>>>>>> WIP: gerrit tests

<<<<<<< 2ff299c5331ec26e09b9648d17995387e5f5cfd0
    @hooks = qw/ applypatch-msg pre-applypatch post-applypatch
        pre-commit prepare-commit-msg commit-msg
        post-commit pre-rebase post-checkout post-merge
        pre-receive update post-receive post-update
        pre-auto-gc post-rewrite /
            unless @hooks;
||||||| merged common ancestors
    @hooks = qw/ applypatch-msg pre-applypatch post-applypatch
		 pre-commit prepare-commit-msg commit-msg
		 post-commit pre-rebase post-checkout post-merge
		 pre-receive update post-receive post-update
		 pre-auto-gc post-rewrite /
                     unless @hooks;
=======
    unless (@hooks) {
        @hooks = qw/ applypatch-msg pre-applypatch post-applypatch
                     pre-commit prepare-commit-msg commit-msg post-commit
                     pre-rebase post-checkout post-merge pre-receive
                     update post-receive post-update pre-auto-gc
                     post-rewrite /;
        push @hooks, keys(%gerrit_hooks) if $gerrit_config;
    }
>>>>>>> WIP: gerrit tests

    foreach my $hook (@hooks) {
<<<<<<< 2ff299c5331ec26e09b9648d17995387e5f5cfd0
        my $hookfile = $hooks_dir->child($hook);
        if ($^O eq 'MSWin32') {
||||||| merged common ancestors
	my $hookfile = catfile($hooks_dir, $hook);
	if ($^O eq 'MSWin32') {
=======
	my $hookfile = catfile(exists $gerrit_hooks{$hook} ? $gerrit_config->{hooks_dir} : $hooks_dir, $hook);
	if ($^O eq 'MSWin32') {
>>>>>>> WIP: gerrit tests
            (my $perl = $^X) =~ tr:\\:/:;
            $hook_pl =~ tr:\\:/:;
            my $d = $ENV{DBG} ? '-d' : '';
            my $script = <<"EOF";
#!/bin/sh
$perl $d $hook_pl $hook \"\$@\"
EOF
<<<<<<< 2ff299c5331ec26e09b9648d17995387e5f5cfd0
            path($hookfile)->spew($script)
                or BAIL_OUT("can't path('$hookfile')->spew('$script')\n");
            chmod 0755 => $hookfile;
        } else {
            symlink 'hook.pl', $hookfile
                or BAIL_OUT("can't symlink '$hooks_dir', '$hook': $!");
||||||| merged common ancestors
            write_file($hookfile, {err_mode => 'carp'}, $script)
                or BAIL_OUT("can't write_file('$hookfile', '$script')\n");
	    chmod 0755 => $hookfile;
	} else {
            symlink 'hook.pl', $hookfile
                or BAIL_OUT("can't symlink '$hooks_dir', '$hook': $!");
=======
            write_file($hookfile, {err_mode => 'carp'}, $script)
                or BAIL_OUT("can't write_file('$hookfile', '$script')\n");
	    chmod 0755 => $hookfile;
        } elsif (-e $hookfile) {
            -l $hookfile && readlink($hookfile) eq $hook_pl
                or BAIL_OUT("can't symlink('$hook_pl', '$hookfile') because the target already exists.");
	} else {
            symlink $hook_pl, $hookfile
                or BAIL_OUT("can't symlink('$hook_pl', '$hookfile'): $!");
>>>>>>> WIP: gerrit tests
        }
    }
    return;
}

sub new_repos {
<<<<<<< 2ff299c5331ec26e09b9648d17995387e5f5cfd0
    my $repodir  = $T->child('repo');
    my $filename = $repodir->child('file.txt');
    my $clonedir = $T->child('clone');
||||||| merged common ancestors
    my $repodir  = catfile($T, 'repo');
    my $filename = catfile($repodir, 'file.txt');
    my $clonedir = catfile($T, 'clone');
=======
    my $repodir   = catfile($T, 'repo');
    my $filename  = catfile($repodir, 'file.txt');
    my $clonedir  = catfile($T, 'clone');
>>>>>>> WIP: gerrit tests

    # Remove the directories recursively to create new ones.
    $repodir->remove_tree({safe => 0});
    $clonedir->remove_tree({safe => 0});

    mkdir $repodir, 0777 or BAIL_OUT("can't mkdir $repodir: $!");
    {
        open my $fh, '>', $filename or die BAIL_OUT("can't open $filename: $!");
        say $fh "first line";
        close $fh;
    }

    my $stderr = $T->child('stderr');

    return try {
        my ($repo, $clone);

        {
            # It would be easier to pass a directory argument to
            # git-init but it started to accept it only on v1.6.5. To
            # support previous gits we chdir to $repodir to avoid the
            # need to pass the argument. Then we have to go back to
            # where we were.
            my $dir = pushd($repodir);
            Git::command(qw/init -q/, "--template=$tmpldir");

            $repo = Git::More->repository(Directory => '.');

            $repo->command(config => 'user.email', 'myself@example.com');
            $repo->command(config => 'user.name',  'My Self');
        }

        open my $err_h, '>', $T->child('stderr');
        Git::command(
            [qw/clone -q --bare --no-hardlinks/, "--template=$tmpldir", $repodir, $clonedir],
            { STDERR => $err_h },    # do not complain about cloning an empty repo
        );
        close $err_h;

        $clone = Git::More->repository(Repository => $clonedir);

        $repo->command(qw/remote add clone/, $clonedir);

<<<<<<< 2ff299c5331ec26e09b9648d17995387e5f5cfd0
        return ($repo, $filename, $clone, $T);
||||||| merged common ancestors
	return ($repo, $filename, $clone, $T);
=======
        if ($gerrit_config) {
            my $gerritdir = catfile($T, 'gerrit');
            Git::command(qw/clone -q/, $gerrit_config->{repo_url}, $gerritdir);
            $gerrit_config->{git}  = Git::More->repository($gerritdir);
            $gerrit_config->{file} = catfile($gerritdir, $gerrit_config->{file});
            unless (-f $gerrit_config->{file}) {
                write_file($gerrit_config->{file}, {err_mode => 'carp'}, "line\n")
                    or die "can't write_file('$gerrit_config->{file}')\n";
            }
        }

	return ($repo, $filename, $clone, $T, $gerrit_config);
>>>>>>> WIP: gerrit tests
    } otherwise {
        my $E = shift;
        my $exception = "$E";   # stringify it
        if (-s $stderr) {
            open my $err_h, '<', $stderr;
            local $/ = undef;   # slurp mode
            $exception .= 'STDERR=';
            $exception .= <$err_h>;
            close $err_h;
        }

        # The BAIL_OUT function can't show a message with newlines
        # inside. So, we have to make sure to get rid of any.
        $exception =~ s/\n/;/g;
        local $, = ':';
        BAIL_OUT("Error setting up repos for test: Exception='$exception'; CWD=$T; git-version=$git_version; \@INC=(@INC).\n");
    };
}

sub new_commit {
    my ($git, $file, $msg) = @_;

    $file->append($msg || 'new commit');

    $git->command(add => $file);
    $git->command(commit => '-q', '-m', $msg || 'commit');

    return;
}


# Executes a git command with arguments and return a four-elements
# list containing: (a) a boolean indication of success, (b) the exit
# code, (c) the command's STDOUT, and (d) the command's STDERR.
sub test_command {
    my ($git, $cmd, @args) = @_;

    ## no critic (RequireBriefOpen)

    # Redirect STDERR to a temporary file
    open my $oldstderr, '>&', \*STDERR
        or die "Can't dup STDERR: $!";
    open STDERR, '>', 'stderr'
        or die "Can't redirect STDERR to temporary directory: $!";

    my ($stdout, $exception);

    try {
        $stdout = $git->command($cmd, @args);
        $stdout = '' unless defined $stdout;
    } otherwise {
        $exception = "$_[0]"; # stringify the exception
    };

    # Redirect STDERR back to its original value
    open STDERR, '>&', $oldstderr
        or die "Can't redirect STDERR back to its original value: $!";

    # Grok the subcomand's STDERR
    my $stderr = path('stderr')->slurp;

    if (defined $exception) {
        return (0, $?, $exception, $stderr);
    } else {
        return (1, 0, $stdout, $stderr);
    }
}

sub test_ok {
    my ($testname, @args) = @_;
    my ($ok, $exit, $stdout, $stderr) = test_command(@args);
    if ($ok) {
        pass($testname);
    } else {
        fail($testname);
        diag(" exit=$exit\n stdout=$stdout\n stderr=$stderr\n git-version=$git_version\n");
    }
    return $ok;
}

sub test_ok_match {
    my ($testname, $regex, @args) = @_;
    my ($ok, $exit, $stdout, $stderr) = test_command(@args);
    if ($ok) {
        if ($stdout =~ $regex || $stderr =~ $regex) {
            pass($testname);
        } else {
            fail($testname);
            diag(" did not match regex ($regex)\n stdout=$stdout\n stderr=$stderr\n git-version=$git_version\n");
        }
    } else {
        fail($testname);
        diag(" exit=$exit\n stdout=$stdout\n stderr=$stderr\n git-version=$git_version\n");
    }
    return $ok;
}

sub test_nok {
    my ($testname, @args) = @_;
    my ($ok, $exit, $stdout, $stderr) = test_command(@args);
    if ($ok) {
        fail($testname);
        diag(" succeeded without intention\n stdout=$stdout\n stderr=$stderr\n git-version=$git_version\n");
    } else {
        pass($testname);
    }
    return !$ok;
}

sub test_nok_match {
    my ($testname, $regex, @args) = @_;
    my ($ok, $exit, $stdout, $stderr) = test_command(@args);
    if ($ok) {
        fail($testname);
        diag(" succeeded without intention\n exit=$exit\n stdout=$stdout\n stderr=$stderr\n git-version=$git_version\n");
        return 0;
    } elsif ($stdout =~ $regex || $stderr =~ $regex) {
        pass($testname);
        return 1;
    } else {
        fail($testname);
        diag(" did not match regex ($regex)\n exit=$exit\n stdout=$stdout\n stderr=$stderr\n git-version=$git_version\n");
        return 0;
    }
}

1;