Hi,
I've been hacking around with CPANPLUS::Dist::YACSmoke recently to try
and implement skipping the prepare/create
stages if the build directory for a distribution exists and has been
successfully built previously.
I have managed to implement most of this functionality in CP:D:YS, but
because of the way that I do testing
I found that the fetch and extract of prereq dists would still take place.
Attached is a patch against the svn development version of CPANPLUS that
adds a config option 'build_dir_reuse'
If set _build_dir_reuse() in CPANPLUS::Module gets called before and
after fetch() and extract() to set/save the
appropriate ->status values.
Seems to be robust enough, I have tested by doing a smoke run with it,
in conjuction with CPANPLUS::Dist::YACSmoke 0.27_01
and it has sped up CPAN testing considerably.
Many thanks,
| Subject: | build_dir_reuse.diff |
Index: lib/CPANPLUS/Config.pm
===================================================================
--- lib/CPANPLUS/Config.pm (revision 2476)
+++ lib/CPANPLUS/Config.pm (working copy)
@@ -456,6 +456,17 @@
$Conf->{'conf'}->{'cpantest_reporter_args'} = {};
+=item build_dir_reuse
+
+A boolean indicating whether or not to reuse distribution build directories.
+Writes some meta to the build directory to save fetch and extraction locations
+for later use. Useful for CPAN Testers. Default is false.
+L<YAML::Tiny> is required for this option.
+
+=cut
+
+ $Conf->{'conf'}->{'build_dir_reuse'} = 0;
+
=back
=head2 Section 'program'
Index: lib/CPANPLUS/Module.pm
===================================================================
--- lib/CPANPLUS/Module.pm (revision 2476)
+++ lib/CPANPLUS/Module.pm (working copy)
@@ -949,6 +949,16 @@
return;
}
+ # Load build_dir_reuse meta
+
+ if ( $conf->get_conf('build_dir_reuse') ) {
+ my $params;
+ for (qw[verbose extractdir]) {
+ $params->{$_} = $args->{$_} if exists $args->{$_};
+ }
+ $self->_build_dir_reuse( method => 'fetch', %$params );
+ }
+
### fetch it if need be ###
unless( $self->status->fetch ) {
my $params;
@@ -973,6 +983,16 @@
$self->extract( %$params ) or return;
}
+ # Store build_dir_reuse meta
+
+ if ( $conf->get_conf('build_dir_reuse') ) {
+ my $params;
+ for (qw[verbose extractdir]) {
+ $params->{$_} = $args->{$_} if exists $args->{$_};
+ }
+ $self->_build_dir_reuse( method => 'store', %$params );
+ }
+
$format ||= $self->status->installer_type;
unless( $format ) {
@@ -1728,6 +1748,59 @@
return;
}
+sub _build_dir_reuse {
+ my $self = shift;
+ my $cb = $self->parent;
+ my $conf = $cb->configure_object();
+ my %hash = @_;
+
+ return unless $conf->get_conf('build_dir_reuse');
+
+ my ($verbose,$method);
+ my $tmpl = {
+ verbose => { default => $conf->get_conf('verbose'),
+ store => \$verbose, },
+ method => { required => 1,
+ store => \$method,
+ allow => [qw|fetch store|],
+ },
+ extractdir => { default => $conf->get_conf('extractdir'), },
+ perl => { default => $^X },
+ };
+
+ my $args = check( $tmpl, \%hash ) or return;
+
+ return unless can_load(
+ modules => { 'YAML::Tiny' => '0.0' },
+ verbose => $verbose,
+ );
+
+ my $build_dir = $args->{'extractdir'} ||
+ File::Spec->catdir(
+ $conf->get_conf('base'),
+ $cb->_perl_version( perl => $args->{'perl'} ),
+ $conf->_get_build('moddir'),
+ );
+
+ my $yml_file = File::Spec->catfile( $build_dir, $self->package_name . '-' . $self->version . '.yml' );
+
+ if ( $method eq 'store' ) {
+ my $data = { };
+ $data->{$_} = $self->status->$_ for qw(fetch extract);
+ eval { YAML::Tiny::DumpFile( $yml_file, $data ) };
+ }
+ else {
+ return unless -e $yml_file;
+ my $data = eval { YAML::Tiny::LoadFile( $yml_file ) };
+ return unless $data;
+ # Sanity check
+ return unless $data->{fetch} and -e $data->{fetch};
+ return unless $data->{extract} and -e $data->{extract};
+ $self->status->$_( $data->{$_} ) for qw(fetch extract);
+ }
+ return 1;
+}
+
=pod
=head1 BUG REPORTS