## 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;