Author: dagolden
Date: Wed Sep 2 07:42:43 2009
New Revision: 13258
Modified:
Module-Build/trunk/t/README.pod
Module-Build/trunk/t/lib/DistGen.pm
Module-Build/trunk/t/lib/MBTest.pm
Module-Build/trunk/t/sample.t
Log:
clean up DistGen and make it DWIM more
Modified: Module-Build/trunk/t/README.pod
==============================================================================
--- Module-Build/trunk/t/README.pod (original)
+++ Module-Build/trunk/t/README.pod Wed Sep 2 07:42:43 2009
@@ -34,16 +34,15 @@
use DistGen;
# create dist object in a temp directory
- # MBTest uses different dirs for Perl core vs CPAN testing
- my $dist = DistGen->new( dir => MBTest->tmpdir );
-
- # generate the skeleton files and also schedule cleanup
- $dist->regen;
- END{ $dist->remove }
+ my $dist = DistGen->new;
# enter the test distribution directory before further testing
$dist->chdir_in;
+ # generate the skeleton files
+ $dist->regen;
+
+
=head1 GETTING A MODULE::BUILD OBJECT
From inside the test distribution, you can get the Module::Build object
@@ -82,7 +81,7 @@
);
$dist->regen;
- # Regenerate the distribution and test it
+ # Get a new build object and test it
$mb = $dist->new_from_context;
is( $mb->license, "artistic", "saw 'artistic' license" );
Modified: Module-Build/trunk/t/lib/DistGen.pm
==============================================================================
--- Module-Build/trunk/t/lib/DistGen.pm (original)
+++ Module-Build/trunk/t/lib/DistGen.pm Wed Sep 2 07:42:43 2009
@@ -18,6 +18,7 @@
use IO::File ();
use Tie::CPHash;
use Data::Dumper;
+require MBTest; # for tmpdir
my $vms_mode;
my $vms_lower_case;
@@ -76,7 +77,7 @@
my %options = @_;
$options{name} ||= 'Simple';
- $options{dir} ||= Cwd::cwd();
+ $options{dir} ||= MBTest->tmpdir( CLEANUP => 0 );
my %data = (
no_manifest => 0,
@@ -87,21 +88,30 @@
# So we can clean up later even if the caller chdir()s
$self->{dir} = File::Spec->rel2abs($self->{dir});
+ $self->{original_dir} = Cwd::cwd; # only once
tie %{$self->{filedata}}, 'Tie::CPHash';
tie %{$self->{pending}{change}}, 'Tie::CPHash';
+ # start with a fresh, empty directory
if ( -d $self->dirname ) {
warn "Warning: Removing existing directory '@{[$self->dirname]}'\n";
$self->remove;
}
+ File::Path::mkpath( $self->dirname );
$self->_gen_default_filedata();
return $self;
}
+sub DESTROY {
+ my ($self) = @_;
+ $self->chdir_original;
+ $self->remove;
+}
+
sub _gen_default_filedata {
my $self = shift;
@@ -339,6 +349,7 @@
}
$self->_gen_manifest( $manifest );
}
+ return $self;
}
sub clean {
@@ -396,6 +407,7 @@
}, ($^O eq 'VMS' ? './' : File::Spec->curdir) );
chdir_all( $here );
+ return $self;
}
sub remove {
@@ -405,6 +417,7 @@
File::Path::rmtree( $self->dirname );
# might as well check
croak("\nthis test should have used chdir_in()") unless(Cwd::getcwd);
+ return $self;
}
sub revert {
@@ -425,6 +438,7 @@
}
delete( $self->{filedata}{$file} );
$self->{pending}{remove}{$file} = 1;
+ return $self;
}
sub change_build_pl {
@@ -449,6 +463,7 @@
);
\$b->create_build_script();
---
+ return $self;
}
sub change_file {
@@ -457,6 +472,7 @@
my $data = shift;
$self->{filedata}{$file} = $data;
$self->{pending}{change}{$file} = 1;
+ return $self;
}
sub get_file {
@@ -468,26 +484,23 @@
sub chdir_in {
my $self = shift;
-
- $self->{original_dir} ||= Cwd::cwd; # only once
+ $self->{did_chdir} = 1;
my $dir = $self->dirname;
chdir($dir) or die "Can't chdir to '$dir': $!";
+ return $self;
}
########################################################################
-sub did_chdir {
- my $self = shift;
+sub did_chdir { shift()->{did_chdir} }
- return exists($self->{original_dir});
-}
########################################################################
sub chdir_original {
my $self = shift;
- croak("never called chdir_in()") unless($self->{original_dir});
my $dir = $self->{original_dir};
chdir_all($dir) or die "Can't chdir to '$dir': $!";
+ return $self;
}
########################################################################
@@ -500,14 +513,14 @@
sub run_build_pl {
my ($self, @args) = @_;
require Module::Build;
- Module::Build->run_perl_script('Build.PL', [], [...@args])
+ return Module::Build->run_perl_script('Build.PL', [], [...@args])
}
sub run_build {
my ($self, @args) = @_;
require Module::Build;
my $build_script = $^O eq 'VMS' ? 'Build.com' : 'Build';
- Module::Build->run_perl_script($build_script, [], [...@args])
+ return Module::Build->run_perl_script($build_script, [], [...@args])
}
1;
@@ -524,8 +537,7 @@
use DistGen;
# create distribution and prepare to test
- my $dist = DistGen->new(name => 'Foo::Bar', dir => $tmp);
- $dist->regen;
+ my $dist = DistGen->new(name => 'Foo::Bar');
$dist->chdir_in;
# change distribution files
@@ -541,18 +553,20 @@
$dist->run_build_pl();
$dist->run_build('test');
- # finish testing and clean up
- $dist->chdir_original;
- $dist->remove;
+ # destructor returns to original dir and removes $dist dir
+ undef $dist
=head1 USAGE
A DistGen object manages a set of files in a distribution directory.
-The constructor and some methods only define the target state of the
-distribution. They do B<not> make any changes to the filesystem:
+The C<new()> constructor initializes the object and creates an empty
+directory for the distribution. It does not create files or chdir into
+the directory.
+
+Some methods only define the target state of the distribution. They do B<not>
+make any changes to the filesystem:
- new
add_file
change_file
change_build_pl
@@ -566,10 +580,9 @@
remove
Other methods are provided for a convenience during testing. The
-most important are ones that manage the current directory:
+most important is the one to enter the distribution directory:
chdir_in
- chdir_original
Additional methods portably encapsulate running Build.PL and Build:
@@ -582,7 +595,11 @@
=head3 new()
-Create a new object. Does not write its contents (see L</regen()>.)
+Create a new object and an empty directory to hold the distribution's files.
+If no C<dir> option is provided, it defaults to MBTest->tmpdir, which sets
+a different temp directory for Perl core testing and CPAN testing.
+
+The C<new> method does not write any files -- see L</regen()> below.
my $tmp = MBTest->tmpdir;
my $dist = DistGen->new(
@@ -604,9 +621,14 @@
=item dir
-The (parent) directory in which to create the distribution directory.
-The default is File::Spec->curdir. The distribution will be created
-under this according to the "dist" form of C<name> (e.g. "Foo-Bar".)
+The (parent) directory in which to create the distribution directory. The
+distribution will be created under this according to the "dist" form of C<name>
+(e.g. "Foo-Bar".) Defaults to a temporary directory.
+
+ $dist = DistGen->new( dir => '/tmp/MB-test' );
+ $dist->regen;
+
+ # distribution files have been created in /tmp/MB-test/Simple
=item xs
Modified: Module-Build/trunk/t/lib/MBTest.pm
==============================================================================
--- Module-Build/trunk/t/lib/MBTest.pm (original)
+++ Module-Build/trunk/t/lib/MBTest.pm Wed Sep 2 07:42:43 2009
@@ -105,6 +105,8 @@
{
my $cwd = Cwd::cwd;
+ sub original_cwd { return $cwd }
+
END {
# Go back to where you came from!
chdir $cwd or die "Couldn't chdir to $cwd";
@@ -123,11 +125,9 @@
# Setup a temp directory
sub tmpdir {
- my ($self, $usr_tmp) = @_;
- return File::Temp::tempdir( 'MB-XXXXXXXX',
- CLEANUP => 1, DIR => $ENV{PERL_CORE} ? Cwd::cwd :
- $usr_tmp ? $usr_tmp : File::Spec->tmpdir
- );
+ my ($self, @args) = @_;
+ my $dir = $ENV{PERL_CORE} ? Cwd::cwd : File::Spec->tmpdir;
+ return File::Temp::tempdir('MB-XXXXXXXX', CLEANUP => 1, DIR => $dir, @args);
}
sub save_handle {
Modified: Module-Build/trunk/t/sample.t
==============================================================================
--- Module-Build/trunk/t/sample.t (original)
+++ Module-Build/trunk/t/sample.t Wed Sep 2 07:42:43 2009
@@ -9,18 +9,11 @@
blib_load('Module::Build');
# create dist object in a temp directory
-# MBTest uses different dirs for Perl core vs CPAN testing
-my $dist = DistGen->new;
-
-# generate the skeleton files and also schedule cleanup
-$dist->regen;
-END{ $dist->remove }
-
-# enter the test distribution directory before further testing
-$dist->chdir_in;
+# enter the directory and generate the skeleton files
+my $dist = DistGen->new->chdir_in->regen;
# get a Module::Build object and test with it
-my $mb = $dist->new_from_context( quiet => 1 );
+my $mb = $dist->new_from_context(); # quiet by default
isa_ok( $mb, "Module::Build" );
is( $mb->dist_name, "Simple", "dist_name is 'Simple'" );
