If you recall, in our last episode I hacked together a quick solution to smoke all of Dancer’s plugins and know how they fare, with regard to Dancer 1 versus Dancer 2.
After that blog entry, I thought it would be fun to revisit the problem and try to implement a more general solution. The experiment, I decided, would have the following goals: At its base, it would have to be generic enough to be able to smoke any module and provide the flexibility required to be easily extensible. To exercise that said extensibility, I would have to implement two plugins: one that retrieves the module-to-test from a Pinto repository and another that saves the testing results in a database. So basically, I have all the goodies of the hack, but they’re rephrased in a way that will allow me to use it for other, future nefarious ends.
I won’t keep you in suspense. The experiment fared quite well (or so I like to think) and is now available on GitHub. It’s full of stubbed functionality and still needs much work, but it’s doing something. Here, let me show you.
Here, Smoke That
At the core, we want the raw smoking functionality: We want to shove a tarball in, and we want the tap report out. So that’s what we’re going to have our main module, Smoke::Module, do. (And you have no idea how hard it was for me not to call that module Smoked::Meat).
use 5.10.0;
use strict;
use warnings;
use Moose;
use MooseX::Types::Path::Class;
use Method::Signatures;
use Path::Class qw/ dir file /;
use File::chdir;
use Archive::Tar;
use TAP::Harness::Archive;
use IPC::Run3;
with ‘MooseX::Role::Tempdir’ => {
dirs => [qw/ tempdir /],
tmpdir_opts => { CLEANUP => 1 },
};
with ‘MooseX::Role::Loggable’;
has tarball => (
is => ‘ro’,
isa => ‘Path::Class::File’,
required => 1,
coerce => 1,
);
has package_name => ( is => ‘rw’, );
has package_version => ( is => ‘rw’, );
has tarball_extracted => (
isa => ‘Bool’,
default => 0,
is => ‘rw’,
);
has extract_dir => (
is => ‘ro’,
isa => ‘Path::Class::Dir’,
coerce => 1,
lazy => 1,
default => method {
my $dir = dir( $self->tempdir );
$self->_extract_tarball($dir) unless $self->tarball_extracted;
return $dir;
},
);
has perl_exec => (
is => ‘ro’,
default => $^X,
);
has tap_report => (
is => ‘rw’,
isa => ‘TAP::Parser::Aggregator’,
lazy => 1,
handles => { test_status => ‘get_status’, },
builder => ‘generate_tap_report’,
);
method generate_tap_report {
my $report = $self->_run_tests;
$self->tap_reports_generated;
return $report;
};
sub tap_reports_generated {
# do nothing, just an action milestone marker
# for the plugins
}
method _extract_tarball($extract_dir) {
my $tar = Archive::Tar->new;
$tar->read( $self->tarball );
local $CWD = $extract_dir;
$self->log_debug("extracting tarball to $CWD");
for my $file ( $tar->list_files ) {
( my $dest = $file ) =~ s#^.*?/##;
$tar->extract_file( $file => $extract_dir->file($dest)->stringify );
}
$self->tarball_extracted(1);
}
method extract_tarball {
$self->_extract_tarball( $self->extract_dir )
unless $self->tarball_extracted;
}
before _run_tests => method {
$self->extract_tarball;
};
method _run_tests {
local $CWD = $self->extract_dir->stringify;
if ( -f ‘Build.PL’ ) {
$self->log_debug("Build.PL detected");
run3 [ $self->perl_exec, ‘Build.PL’ ],
\undef, sub { $self->log_debug(@_) }, sub { $self->log_debug(@_) };
run3 [‘./Build’],
\undef, sub { $self->log_debug(@_) }, sub { $self->log_debug(@_) };
}
elsif ( -f ‘Makefile.PL’ ) {
$self->log_debug("Makefile.PL detected");
run3 [ $self->perl_exec, ‘Makefile.PL’ ],
\undef, sub { $self->log_debug(@_) }, sub { $self->log_debug(@_) };
run3 [‘make’],
\undef, sub { $self->log_debug(@_) }, sub { $self->log_debug(@_) };
}
else {
die "no Build.PL or Makefile.PL found\n";
}
run3 [ ‘prove’, ‘-b’, ‘–archive’, ‘tap.tar.gz’, ‘t’ ];
# TODO we could also scoop the meta.yml from the results
return TAP::Harness::Archive->aggregator_from_archive(
{ archive => $self->extract_dir->file(‘tap.tar.gz’) } );
}
method run_tests {
$self->tap_report( $self->_run_tests );
$self->tap_reports_generated;
return $self->test_status;
}
1;
[/perl]
As usual, the trick is to find the modules that do the hard parts and glue them together. The tarball is extracted via the good services of Archive::Tar, in a directory kindly provided by MooseX::Role::Tempdir. We run the distribution Build.PL/Makefile.PL with the assistance of IPC::Run3. The running of the test and creation of the TAP archive is delegated to prove, and the slurping back of said archive is done by TAP::Harness::Archive, which gives us a TAP::Parser::Aggregator with all the goods. And thanks to the lazy builders sprinkled everywhere, using the module turns out to be very short and sweet:
-E’say Smoke::Module->new( tarball => shift )->test_status’ \
Dancer-Plugin-Cache-CHI-1.3.1.tar.gz
t/00-compile.t …… ok
t/basic.t ……….. ok
t/honor-no-cache.t .. ok
t/hooks.t ……….. ok
t/key-gen.t ……… ok
t/namespaces.t …… ok
All tests successful.
Files=6, Tests=42, 4 wallclock secs ( 0.04 usr 0.01 sys + 1.84 cusr 0.17 csys = 2.06 CPU)
Result: PASS
TAP Archive created at /tmp/sae8spnE_K/tap.tar.gz
PASS
[/bash]
Uh. Okay, I still have to figure out why prove won’t shut up, but beside that, ain’t that sweet?
For Good Smoking, You Have to Have Good Tar(balls)
Now that we have the core, let’s turn our attention to our plugins. For the first one, we want to turn things around a little bit. Instead of providing a tarball directly, we’ll provide a module name (and possibly a version) and let the system figure out how to borrow it from Pinto.
use 5.10.0;
use strict;
use warnings;
use Moose::Role;
use MooseX::Role::AttributeOverride;
use Method::Signatures;
use Pinto::Schema;
use version;
has_plus ‘tarball’ => (
required => 0,
lazy => 1,
default => \&_pinto_tarball,
);
has pinto_root => (
is => ‘ro’,
lazy => 1,
default => sub {
$ENV{PINTO_REPOSITORY_ROOT} or
die "Module::Pinto::new() requires argument ‘pinto_root’\n"
},
);
method _pinto_tarball {
my $schema = Pinto::Schema->connect(
‘dbi:SQLite:’ . $self->pinto_root . ‘/.pinto/db/pinto.db’ );
die "either argument ‘package_name’ or ‘tarball’ has to be given\n"
unless $self->package_name;
my $rs = $schema->resultset(‘Package’)->search({
name => $self->package_name,
});
# has version ? => find that one
# has not? take the highest version
my $package;
if ( $self->package_version ) {
$rs = $rs->search({ version => $self->package_version });
$package = $rs->first;
}
else {
( $package ) = reverse sort {
version->parse($a->version) <=> version->parse($b->version)
} $rs->all;
$self->package_version( $package->version );
}
return $self->pinto_root . ‘/’ .$package->distribution->native_path;
}
1;
[/perl]
The sneaky bit in that role is how we change the nature of the tarball attribute. Usually, roles aren’t supposed to mess with the base class’s attributes that way, but thanks to MooseX::Role::AttributeOverride, we do have a way to work against the fundamental laws of Nature. It worked for Viktor Von Frankenstein. I don’t see why it wouldn’t for us…
And Pipe The Results To The Database
Ye gods, I can’t believe I just made that pun. I’m so ashamed, I wish I could crawl under the carpet or disappear in a puff of sm– aaaanyway…
So, yeah, last bit: Intercept the results and store them in a database. And for that kind of job, I’m very quickly growing quite fond of my little DBIx::NoSQL::Store::Manager module:
[perl]package Smoke::Module::Store;use 5.10.0;
use strict;
use warnings;
use Moose::Role;
use MooseX::Storage::Engine;
use DBIx::NoSQL::Store::Manager;
use Method::Signatures;
use MooseX::Role::AttributeOverride;
use MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize;
with ‘DBIx::NoSQL::Store::Manager::Model’;
has store_db => (
is => ‘ro’,
lazy => 1,
default => sub {
my $store = DBIx::NoSQL::Store::Manager->new(
model => ‘Smoke::Module’,
);
MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize->meta->apply(
$_[0]->meta->find_attribute_by_name($_)
) for qw/
debug
logger
logger_facility
logger_ident
log_to_file
log_to_stdout
log_file
log_path
log_pid
log_fail_fatal
log_muted
log_quiet_fatal
/;
$store->json->allow_blessed(1);
$store->connect( ‘test.sqlite’ );
return $store;
}
);
has_plus ‘store_key’ => (
default => method {
join " : ", $self->package_name, $self->package_version, scalar localtime;
}
);
after tap_reports_generated => sub { $_[0]->store };
MooseX::Storage::Engine->add_custom_type_handler(
‘Path::Class::Dir’ => (
expand => sub { dir(shift) },
collapse => sub { ”.shift },
),
);
MooseX::Storage::Engine->add_custom_type_handler(
‘Path::Class::File’ => (
expand => sub { file(shift) },
collapse => sub { ”.shift },
)
);
MooseX::Storage::Engine->add_custom_type_handler(
$_ => (
expand => sub { bless shift, $_ },
collapse => sub { return { %{$_[0]} } },
)
) for qw/
TAP::Parser::Aggregator
TAP::Parser
File::Temp::Dir
/;
1;
[/perl]Most of the code in that module is there to oil the gears of MooseX::Storage, tell it which attributes aren’t worth serializing, and to show how to serialize the different attribute objects.
Get the Pieces Together
We could probably still find a way to run the base class with all the roles as a one-liner, but that would be just be showing-off. Instead, let’s do things properly: the long-hand way:
[bash]$ cat smoker.pl#!/usr/bin/env perl
use 5.10.0;
package Smoked;
use Moose;
extends ‘Smoke::Module’;
with ‘Smoke::Module::Pinto’;
with ‘Smoke::Module::Store’;
say __PACKAGE__->new(
package_name => $_,
debug => 1,
log_to_stdout => 1,
)->run_tests for @ARGV;
$ ./smoker Dancer::Plugin::Cache::CHI
[6295] extracting tarball to /tmp/hREOWmENuC
[6295] Build.PL detected
[6295] Created MYMETA.yml and MYMETA.json
PASS
$ sqlite3 test.sqlite .dump
[..]
INSERT INTO "__Store__" VALUES(‘Smoked’,’Dancer::Plugin::Cache::CHI : v1.3.1 : Thu Oct 4 21:32:32 2012′,'{
"tap_report" : {
"todo_passed" : 0,
"exit" : 0,
"descriptions_for_todo_passed" : [],
"failed" : 0,
"descriptions_for_parse_errors" : [],
"descriptions_for_total" : [
"t/00-compile.t",
"t/basic.t",
"t/honor-no-cache.t",
"t/hooks.t",
"t/key-gen.t",
"t/namespaces.t"
],
"descriptions_for_todo" : [],
"descriptions_for_planned" : [
"t/00-compile.t",
"t/basic.t",
"t/honor-no-cache.t",
"t/hooks.t",
"t/key-gen.t",
"t/namespaces.t"
],
"todo" : 0,
"parse_order" : [
"t/00-compile.t",
"t/basic.t",
"t/honor-no-cache.t",
"t/hooks.t",
"t/key-gen.t",
"t/namespaces.t"
],
"planned" : 42,
"descriptions_for_skipped" : [],
"parse_errors" : 0,
"descriptions_for_exit" : [],
"descriptions_for_passed" : [
"t/00-compile.t",
"t/basic.t",
"t/honor-no-cache.t",
"t/hooks.t",
"t/key-gen.t",
"t/namespaces.t"
],
"parser_for" : {
"t/00-compile.t" : null,
"t/basic.t" : null,
"t/honor-no-cache.t" : null,
"t/hooks.t" : null,
"t/key-gen.t" : null,
"t/namespaces.t" : null
},
"passed" : 42,
"total" : 42,
"skipped" : 0,
"wait" : 0,
"descriptions_for_failed" : [],
"descriptions_for_wait" : []
},
"package_name" : "Dancer::Plugin::Cache::CHI",
"package_version" : null
"tarball" : "/home/yanick/pinto/authors/id/Y/YA/YANICK/Dancer-Plugin-Cache-CHI-1.3.1.tar.gz",
"perl_exec" : "/usr/local/soft/perlbrew/perls/perl-5.14.2/bin/perl",
}
‘);
[..]
[/bash]
Now, picture a few more plugins and a Dancer front-end. Wouldn’t you agree that this could become interesting real fast?
No comments