Taking the Extreme Programming philosophy even further, I wrote this script before the module that I plan to test even had any real tests. What it does is fairly simple:
- Checks out code from an SVN repository.
- Changes into the directory in which the new working copy lives.
- Uses the M::B API to automate running the module's tests.
- Sends email about its results.
I had issues using modules to send email after redirecting the filehandles, so instead I decided to open a pipe directory to sendmail. Yes, it's not portable, especially not to Windows systems. But, I haven't seen the Perl SVI API ported to Windows, so Windows users would have a problem with that anyway.
Please do comment.
#!/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();
UPDATE:As per demerphq's suggestion, I tried MIME::Lite. This introduces a far better way of sending email that actually works. Thanks!
UPDATE^2:Fixed some of the code to deal with using MIME::Lite.