#!/usr/bin/perl
use strict;
use warnings;

use SVN::Client;
use Module::Build;
use MIME::Lite;

my $module_name = 'module_name';
my $starttime = localtime;
my $endtime;
my $svn_user = 'svnuser';
my $svn_passwd = q#pass#;
my ($stdout, $stderr);
my $to = 'mail_target';
my $from = 'mail_sender';
my $subject = "mail_subject";
my $repopath = q#repo_location#;
my $copath = 'where_to_checkout_repo';
my $revision = 'revision';
my $recurse = 1; # checkout subdirectories?
my $msg;

# This sub handles authentication. It's needed by the SVN API.
sub getauth
{
    my $cred = shift;
    $cred->username($svn_user);
    $cred->password($svn_passwd);
} 


my $svnclient = SVN::Client->new
(
    auth =>     [    SVN::Client::get_simple_provider(),
                SVN::Client::get_simple_prompt_provider
                (
                    \&getauth,2
                ),
                SVN::Client::get_username_provider()
            ],
);

# These six lines do a number of things. First, the two 'open OLD'
# lines make copies of STDOUT and STDERR. The 'close STD' and 'open
# STD' lines redirect STDOUT and STDERR to the relevant variables.
# This is so that STDOUT and STDERR can be included in the custom
# email message generated below.

open OLDOUT, '>&STDOUT' or die "dup() of STDOUT failed: $!";
close STDOUT or die "close STDOUT: $!";
open STDOUT, '>', \$stdout or die "redirect STDOUT: $!";

open OLDERR, '>&STDERR' or die "dup() of STDERR failed: $!";
close STDERR or die "close STDERR: $!";
open STDERR, '>', \$stderr or die "redirect STDERR: $!";

# Do the actual checkout.
$svnclient->checkout($repopath, $copath, $revision, $recurse) 
    or die "Couldn't do checkout: $!";
# Change into the target directory.
chdir($copath) or die "chdir(): $!";

# Set up the M::B object...
my $build = Module::Build->new
(
    module_name => $module_name
);
# ... and do the tests. M::B's dispatch() method apparently returns
# like system(): i.e., "true" for failure and "false" for success. I
# haven't investigated this too closely, but I know that it works this
# way.
$build->dispatch('build') and die "dispatch(build): $!";
$build->dispatch('test') and die "dispatch(test): $!";

# Construct the mail.
$endtime = localtime;
$subject .= sprintf("%s/%s", $starttime, $endtime);

my $message = <<"EOF";
Checkout and building for $module_name, started $starttime. 
Finished $endtime.

$stdout

Here's any error output:
$stderr
EOF

# These six lines undo the damage that was done earlier. :) Hereafter,
# normal output to STDOUT and STDERR works again.
close STDOUT or die "close STDOUT: $!";
open STDOUT, ">&", OLDOUT or die "reopen STDOUT: $!";
close OLDOUT or die "close OLDOUT: $!";

close STDERR or die "close STDERR: $!";
open STDERR, ">&OLDERR" or die "reopen STDERR: $!";
close OLDERR or die "close OLDERR: $!";

# Send mail about what has transpired.
my $msg = MIME::Lite->new
(
    To    => $to,
    From    => $from,
    Subject    => $subject,
    Data    => $message
);
$msg->send();
[download]