The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyright (C) 2008-2011 by CPqD

use strict;
use warnings;
use Cwd;
use File::Temp qw/tempdir/;
use File::Spec::Functions;
use File::Path;
use File::Copy;
use URI::file;

# Make sure the svn messages come in English.
$ENV{LC_MESSAGES} = 'C';

sub can_svn {
  CMD:
    for my $cmd (qw/svn svnadmin svnlook/) {
	eval {
	    open my $pipe, '-|', "$cmd --version" or die;
	    local $/ = undef;		# slurp mode
	    <$pipe>;
	    close $pipe or die;
	};
	return 0 if $@;
    }
    return 1;
}

our $T;

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

sub do_script {
    my ($dir, $cmd) = @_;
    my $script = catfile($dir, 'script');
    my $stdout = catfile($dir, 'stdout');
    my $stderr = catfile($dir, 'stderr');
    {
	open my $fd, '>', $script or die;
	print $fd $cmd;
	close $fd;
	chmod 0755, $script;
    }
    copy(catfile($T, 'repo', 'hooks', 'svn-hooks.pl')   => catfile($dir, 'svn-hooks.pl'));
    copy(catfile($T, 'repo', 'conf',  'svn-hooks.conf') => catfile($dir, 'svn-hooks.conf'));

    system("$script 1>$stdout 2>$stderr");
}

sub read_file {
    my ($file) = @_;
    open my $fd, '<', $file or die "Can't open '$file': $!\n";
    local $/ = undef;		# slurp mode
    return <$fd>;
}

sub work_ok {
    my ($tag, $cmd) = @_;
    my $dir = newdir();
    ok((do_script($dir, $cmd) == 0), $tag)
	or diag("work_ok command failed with following stderr:\n",
		scalar(read_file(catfile($dir, 'stderr'))));
}

sub work_nok {
    my ($tag, $error_expect, $cmd) = @_;
    my $dir = newdir();
    my $exit = do_script($dir, $cmd);
    if ($exit == 0) {
	fail($tag);
	diag("work_nok command worked but it shouldn't!\n");
	return;
    }

    my $stderr = scalar(read_file(catfile($dir, 'stderr')));

    if (! ref $error_expect) {
	ok(index($stderr, $error_expect) >= 0, $tag)
	    or diag("work_nok:\n  '$stderr'\n    does not contain\n  '$error_expect'\n");
    }
    elsif (ref $error_expect eq 'Regexp') {
	like($stderr, $error_expect, $tag);
    }
    else {
	fail($tag);
	diag("work_nok: invalid second argument to test.\n");
    }
}

sub get_author {
    my ($t) = @_;
    my $repo = catfile($t, 'repo');
    open my $cmd, '-|', "svnlook info $repo"
	or die "Can't exec svn info\n";
    chomp(my $author = <$cmd>);
    local $/ = undef; <$cmd>;
    close $cmd;
    return $author;
}

sub reset_repo {
    my $cleanup = exists $ENV{REPO_CLEANUP} ? $ENV{REPO_CLEANUP} : 1;
    $T = tempdir('t.XXXX', DIR => getcwd(), CLEANUP => $cleanup);

    my $repo = catfile($T, 'repo');
    my $wc   = catfile($T, 'wc');

    system("svnadmin create $repo");

    my $repouri = URI::file->new($repo);

    system("svn co -q $repouri $wc");

    return $T;
}

1;