# Copyright (C) 2012 by CPqD
use 5.010;
use strict;
use warnings;
use Config;
use File::Remove 'remove';
use File::Slurp;
use File::Spec::Functions qw/catdir catfile/;
use File::Temp 'tempdir';
use File::pushd;
use URI::file;
use Git::More;
use Error qw':try';
# Make sure the git messages come in English.
$ENV{LC_MESSAGES} = 'C';
# 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 = tempdir('githooks.XXXXX', TMPDIR => 1, CLEANUP => $ENV{REPO_CLEANUP} || 1);
chdir $T or die "Can't chdir $T: $!";
END { chdir '/' }
our $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 = catdir($T, $num);
mkdir $dir;
$dir;
}
sub debug_test {
my ($git, $debug) = @_;
$debug //= 1;
my $hook_pl = catfile($git->repo_path(), 'hooks', 'hook.pl');
my $pl = read_file($hook_pl);
if (
! $debug && $pl =~ s/^([^\n]+) -d\n/$1\n/s
|| $debug && $pl =~ s/^([^\n]+)(?!-d)\n/$1 -d\n/s
) {
write_file($hook_pl, $pl);
}
}
sub install_hooks {
my ($git, $extra_perl, @hooks) = @_;
my $hooks_dir = catfile($git->repo_path(), 'hooks');
my $hook_pl = catfile($hooks_dir, 'hook.pl');
{
open my $fh, '>', $hook_pl or BAIL_OUT("Can't create $hook_pl: $!");
state $debug = $ENV{DBG} ? '-d' : '';
state $bliblib = catdir('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";
run_hook(\$0, \@ARGV);
EOF
}
chmod 0755 => $hook_pl;
@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;
foreach (@hooks) {
symlink 'hook.pl', catfile($hooks_dir, $_)
or BAIL_OUT("can't symlink '$hooks_dir', '$_': $!");
}
}
sub new_repos {
my $repodir = catfile($T, 'repo');
my $filename = catfile($repodir, 'file.txt');
my $clonedir = catfile($T, 'clone');
# Remove the directories recursively to create new ones.
remove(\1, $repodir, $clonedir);
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";
}
try {
# 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 ($ok, $exit, $stdout) = do {
my $dir = pushd($repodir);
test_command(undef, 'init', '-q');
};
unless ($ok) {
throw Error::Simple("'git init -q $repodir': exit=$exit, stdout=\n$stdout\n");
}
my $repo = Git::More->repository(Directory => $repodir);
$repo->command(config => 'user.mail', 'myself@example.com');
$repo->command(config => 'user.name', 'My Self');
$repo->command(add => $filename);
$repo->command(commit => '-mx');
($ok, $exit, $stdout) = test_command(undef, 'clone', '-q', '--bare', '--no-hardlinks', $repodir, $clonedir);
unless ($ok) {
throw Error::Simple("'git clone -q --bare --no-hardlinks $repodir $clonedir': exit=$exit, stdout=\n$stdout\n");
}
my $clone = Git::More->repository(Directory => $clonedir);
$repo->command(remote => 'add', 'clone', $clonedir);
return ($repo, $filename, $clone, $T);
} otherwise {
my $E = shift;
my $ls = `find $T -ls`; # FIXME: this is non-portable.
diag("Error setting up repos for test: $E\nRepos parent directory listing:\n$ls\ngit-version=$git_version\n\@INC=@INC\n");
BAIL_OUT('Cannot setup repos for testing');
};
}
sub new_commit {
my ($git, $file, $msg) = @_;
append_file($file, $msg || 'new commit');
$git->command(add => $file);
$git->command(commit => '-q', '-m', $msg || 'commit');
}
sub test_command {
my ($git, $cmd, @args) = @_;
my $pid = open my $pipe, '-|';
if (! defined $pid) {
return (0, undef, "Can't fork: $!\n");
} elsif ($pid) {
# parent
local $/ = undef;
my $stdout = <$pipe>;
my $exit = close $pipe;
if ($exit) {
return (1, undef, $stdout);
} else {
return (0, $!, $stdout);
}
} else {
# child
if (defined $git && $git->repo_path()) {
local $ENV{'GIT_DIR'} = $git->repo_path();
if ($git->wc_path()) {
local $ENV{'GIT_WORK_TREE'} = $git->wc_path();
chdir($git->wc_path());
}
if ($git->wc_subdir()) {
chdir($git->wc_subdir());
}
}
close STDERR;
open STDERR, '>&', \*STDOUT;
exec(git => $cmd, @args)
or BAIL_OUT("Can't exec git (version=$git_version) $cmd: $!\n");
}
}
sub test_ok {
my ($testname, @args) = @_;
my ($ok, $exit, $stdout) = test_command(@args);
if ($ok) {
pass($testname);
} else {
fail($testname);
diag(" exit=$exit\n stdout=$stdout\n git-version=$git_version\n");
}
return $ok;
}
sub test_ok_match {
my ($testname, $regex, @args) = @_;
my ($ok, $exit, $stdout) = test_command(@args);
if ($ok) {
if ($stdout =~ $regex) {
pass($testname);
} else {
fail($testname);
diag(" did not match regex ($regex)\n stdout=$stdout\n git-version=$git_version\n");
}
} else {
fail($testname);
diag(" exit=$exit\n stdout=$stdout\n git-version=$git_version\n");
}
return $ok;
}
sub test_nok {
my ($testname, @args) = @_;
my ($ok, $exit, $stdout) = test_command(@args);
if ($ok) {
fail($testname);
diag(" succeeded without intention\n stdout=$stdout\n git-version=$git_version\n");
} else {
pass($testname);
}
return !$ok;
}
sub test_nok_match {
my ($testname, $regex, @args) = @_;
my ($ok, $exit, $stdout) = test_command(@args);
if ($ok) {
fail($testname);
diag(" succeeded without intention\n stdout=$stdout\n git-version=$git_version\n");
return 0;
} elsif ($stdout =~ $regex) {
pass($testname);
return 1;
} else {
fail($testname);
diag(" did not match regex ($regex)\n exit=$exit\n stdout=$stdout\n git-version=$git_version\n");
return 0;
}
}
1;