Perl-Dist-WiX

changeset 1039:fdf15fdf6ece

Starting work on having multiple modules installable at one time.

At the moment, this:

1) Only installs the specified modules as of yet.
Removing this requirement will require making sure that EU::MM 6.57_07 or
greater is installed as part of the base toolchain.
2) Now requires that Capture::Tiny and File::Slurp become part of the base
toolchain. This has not been done yet.
3) Has not been tested as of yet.

The eventual intention is that the installation script calls CPAN to unpack the
module, reads the MYMETA.* file, and then calls CPAN again to unpack and
install each dependency, then calls CPAN to install the module in a recursive
fashion. I've given the code room to eventually do so (by returning the list of
modules that were installed without validating that it was the same list passed
in.)
author Curtis Jewell <perl@curtisjewell.name>
date Sun Jun 05 21:04:17 2011 -0600 (2011-06-05)
parents a2412418478a
children 6d683fb22a32
files lib/Perl/Dist/WiX/Asset/Module.pm lib/Perl/Dist/WiX/Mixin/Installation.pm lib/Perl/Dist/WiX/Role/NonURLAsset.pm
line diff
     1.1 --- a/lib/Perl/Dist/WiX/Asset/Module.pm	Sun Jun 05 06:40:53 2011 -0600
     1.2 +++ b/lib/Perl/Dist/WiX/Asset/Module.pm	Sun Jun 05 21:04:17 2011 -0600
     1.3 @@ -6,7 +6,7 @@
     1.4  
     1.5  =head1 VERSION
     1.6  
     1.7 -This document describes Perl::Dist::WiX::Asset::Module version 1.500.
     1.8 +This document describes Perl::Dist::WiX::Asset::Module version 1.600.
     1.9  
    1.10  =head1 SYNOPSIS
    1.11  
    1.12 @@ -21,21 +21,23 @@
    1.13  
    1.14  =head1 DESCRIPTION
    1.15  
    1.16 -This asset installs a module from CPAN.
    1.17 +This asset installs module(s) from CPAN.
    1.18  
    1.19  =cut
    1.20  
    1.21 +#<<<
    1.22  use 5.010;
    1.23  use Moose;
    1.24 -use MooseX::Types::Moose qw( Maybe Str Bool );
    1.25 -use English qw( -no_match_vars );
    1.26 -use File::Spec::Functions qw( catdir catfile );
    1.27 -require Perl::Dist::WiX::Exceptions;
    1.28 -require File::List::Object;
    1.29 -require IO::File;
    1.30 +use MooseX::Types::Moose         qw( Maybe Str Bool ArrayRef );
    1.31 +use English                      qw( -no_match_vars );
    1.32 +use File::Spec::Functions        qw( catdir catfile );
    1.33 +use File::Slurp                  qw( slurp_file );
    1.34 +use Perl::Dist::WiX::Exceptions  qw();
    1.35 +use File::List::Object           qw();
    1.36 +use IO::File                     qw();
    1.37 +#>>>
    1.38  
    1.39 -our $VERSION = '1.500001';
    1.40 -$VERSION =~ s/_//ms;
    1.41 +our $VERSION = '1.600';
    1.42  
    1.43  with 'Perl::Dist::WiX::Role::NonURLAsset';
    1.44  
    1.45 @@ -57,7 +59,9 @@
    1.46  
    1.47  =head3 name
    1.48  
    1.49 -The required C<name> param is the name of the module to be installed.
    1.50 +The required C<name> param is the name of the module(s) to be installed.
    1.51 +
    1.52 +Multiple names can be passed in, but must be passed as an arrayref.
    1.53  
    1.54  =cut
    1.55  
    1.56 @@ -65,7 +69,7 @@
    1.57  
    1.58  has name => (
    1.59  	is       => 'ro',
    1.60 -	isa      => Str,
    1.61 +	isa      => Str | ArrayRef[Str]
    1.62  	reader   => 'get_name',
    1.63  	required => 1,
    1.64  );
    1.65 @@ -101,11 +105,13 @@
    1.66  
    1.67  =head3 packlist
    1.68  
    1.69 -This tells the C<install()> routine whether it has a packlist 
    1.70 +This tells the C<install()> routine whether the module(s) have a packlist 
    1.71  that can be found once the module is installed or not.
    1.72  
    1.73  This parameter defaults to true.
    1.74  
    1.75 +To install multiple modules, they must all have packlists.
    1.76 +
    1.77  =cut
    1.78  
    1.79  
    1.80 @@ -143,7 +149,7 @@
    1.81  
    1.82  =head3 feature
    1.83  
    1.84 -Specifies which feature the module is supposed to go in. 
    1.85 +Specifies which feature the module(s) are supposed to go in. 
    1.86  
    1.87  =cut
    1.88  
    1.89 @@ -160,7 +166,7 @@
    1.90  
    1.91  =head2 install
    1.92  
    1.93 -The install method installs the module described by the
    1.94 +The install method installs the module(s) described by the
    1.95  B<Perl::Dist::WiX::Asset::Module> object and returns the files
    1.96  that were installed as a L<File::List::Object|File::List::Object> object.
    1.97  
    1.98 @@ -177,11 +183,20 @@
    1.99  	my $assume        = $self->_get_assume();
   1.100  	my $packlist_flag = $self->_get_packlist();
   1.101  	my $use_sqlite    = $self->_use_sqlite();
   1.102 +	my $output_dir    = $self->_get_output_dir();
   1.103  	my $vendor =
   1.104  	    !$self->_get_parent()->portable()                    ? 1
   1.105  	  : ( $self->_get_parent()->perl_major_version() >= 12 ) ? 1
   1.106  	  :                                                        0;
   1.107 -
   1.108 +	my $multiple_names = 0;
   1.109 +	my $name_ref = [$name];
   1.110 + 
   1.111 +	if (ref $name) { # We have multiple modules to install.
   1.112 +		$name_ref = $name;
   1.113 +		$multiple_names = 1;
   1.114 +		$name = join q{ }, @{$name_ref};
   1.115 +	}
   1.116 +	  
   1.117  	# Verify the existence of perl.
   1.118  	if ( not $self->_get_bin_perl() ) {
   1.119  		PDWiX->throw(
   1.120 @@ -193,9 +208,12 @@
   1.121  	my $url       = $self->_get_cpan()->as_string();
   1.122  	my $dp_dir    = catdir( $self->_get_wix_dist_dir(), 'distroprefs' );
   1.123  	my $internet_available = ( $url =~ m{ \A file://}msx ) ? 1 : 0;
   1.124 -	my $cpan_string        = <<"END_PERL";
   1.125 +	my $cpan_string        = <<"END_PERL"; # TODO: Make this a .tt?
   1.126  print "Loading CPAN...\\n";
   1.127  use CPAN 1.9600;
   1.128 +use Capture::Tiny 0.10 qw(capture_merged);
   1.129 +use File::Spec::Functions qw(catfile);
   1.130 +use File::Slurp qw(write_file);
   1.131  CPAN::HandleConfig->load unless \$CPAN::Config_loaded++;
   1.132  \$CPAN::Config->{'urllist'} = [ '$url' ];
   1.133  \$CPAN::Config->{'use_sqlite'} = q[$use_sqlite];
   1.134 @@ -210,38 +228,56 @@
   1.135  	\$CPAN::Config->{'mbuildpl_arg'} = q[--installdirs vendor];
   1.136  	\$CPAN::Config->{'mbuild_install_arg'} = q[--installdirs vendor];
   1.137  }
   1.138 -print "Installing $name from CPAN...\\n";
   1.139 -my \$module = CPAN::Shell->expandany( "$name" ) 
   1.140 -	or die "CPAN.pm couldn't locate $name";
   1.141 -my \$dist_file = '$dist_file'; 
   1.142 -if ( \$module->uptodate ) {
   1.143 -	unlink \$dist_file;
   1.144 -	print "$name is up to date\\n";
   1.145 -	exit(0);
   1.146 +open(\$cpan_fh, '>', '$dist_file') or die "open: \$!";
   1.147 +MODULE:
   1.148 +foreach \$name (qw($name)) {
   1.149 +	print "Installing \$name from CPAN...\\n";
   1.150 +	my \$module = CPAN::Shell->expandany( "\$name" ) 
   1.151 +		or die "CPAN.pm couldn't locate \$name";
   1.152 +	if ( \$module->uptodate() ) {
   1.153 +		unlink \$dist_file;
   1.154 +		print "\$name is up to date\\n";
   1.155 +		say \$cpan_fh "\$name;;;" or die "say: \$!";
   1.156 +		next MODULE;
   1.157 +	}
   1.158 +	print "\\\$ENV{PATH} = '\$ENV{PATH}'\\n";
   1.159 +	my \$output = capture_merged {
   1.160 +		eval {
   1.161 +			if ( $force ) {
   1.162 +				CPAN::Shell->notest('install', \$name);
   1.163 +			} else {
   1.164 +				CPAN::Shell->install(\$name);
   1.165 +			}
   1.166 +		}
   1.167 +	};
   1.168 +	my \$error = \$@;
   1.169 +	my \$id = \$module->distribution()->pretty_id();
   1.170 +	my \$module_id = \$name;
   1.171 +	\$module_id =~ s{::}{_}gmsx;
   1.172 +	my \$filename = catfile("$output_dir", "\$module_id.output.txt");
   1.173 +	write_file(\$filename, \$output);
   1.174 +	die "Installation of \$name failed: \$error\\n" if $error;
   1.175 +
   1.176 +	say \$cpan_fh "\$name;\$id;\$filename;"  or die "say: \$!";
   1.177 +	print "Completed install of \$name\\n";
   1.178 +	unless ( $assume or \$module->uptodate() ) {
   1.179 +		die "Installation of \$name appears to have failed";
   1.180 +	}
   1.181  }
   1.182 -SCOPE: {
   1.183 -	open( CPAN_FILE, '>', \$dist_file )      or die "open: \$!";
   1.184 -	print CPAN_FILE 
   1.185 -		\$module->distribution()->pretty_id() or die "print: \$!";
   1.186 -	close( CPAN_FILE )                       or die "close: \$!";
   1.187 -}
   1.188 -
   1.189 -print "\\\$ENV{PATH} = '\$ENV{PATH}'\\n";
   1.190 -if ( $force ) {
   1.191 -	CPAN::Shell->notest('install', '$name');
   1.192 -} else {
   1.193 -	CPAN::Shell->install('$name');
   1.194 -}
   1.195 -print "Completed install of $name\\n";
   1.196 -unless ( $assume or \$module->uptodate() ) {
   1.197 -	die "Installation of $name appears to have failed";
   1.198 -}
   1.199 +close( \$cpan_fh ) or die "close: \$!";
   1.200  exit(0);
   1.201  END_PERL
   1.202  
   1.203  	# Scan the perl directory if that's needed.
   1.204  	my $filelist_sub;
   1.205  	if ( not $self->_get_packlist() ) {
   1.206 +		if ($multiple_modules) {
   1.207 +			PDWiX::Parameter->throw(
   1.208 +				parameter => 'packlist: Cannot be 0 when ' 
   1.209 +				  . 'installing multiple modules at once.',
   1.210 +				where => '::Asset::Module->install',
   1.211 +			);
   1.212 +		}
   1.213  		$filelist_sub =
   1.214  		  File::List::Object->new()->readdir( $self->_dir('perl') );
   1.215  		$self->_trace_line( 5,
   1.216 @@ -250,7 +286,7 @@
   1.217  	}
   1.218  
   1.219  	# Dump the CPAN script to a temp file and execute
   1.220 -	$self->_trace_line( 1, "Running install of $name\n" );
   1.221 +	$self->_trace_line( 1, "Running install(s) of $name\n" );
   1.222  	$self->_trace_line( 2, '  at ' . localtime() . "\n" );
   1.223  	my $cpan_file = catfile( $self->_get_build_dir(), 'cpan_string.pl' );
   1.224    SCOPE: {
   1.225 @@ -270,36 +306,55 @@
   1.226  
   1.227  	if ($CHILD_ERROR) {
   1.228  		PDWiX->throw(
   1.229 -			"Failure detected installing $name, stopping [$CHILD_ERROR]");
   1.230 +			"Failure detected installing module(s), stopping [$CHILD_ERROR]");
   1.231  	}
   1.232  
   1.233 -	# Read in the dist file and add it the the list of
   1.234 +	# Read in cpan_distro.txt and add the distributions listed to the list of
   1.235  	# distributions that were installed.
   1.236 +	# Also read the filelists from the modules installed.
   1.237 +	my (%filelists, @modules_installed);
   1.238  	if ( -r $dist_file ) {
   1.239 -		my $fh = IO::File->new( $dist_file, 'r' );
   1.240 -		if ( not defined $fh ) {
   1.241 -			PDWiX->throw("CPAN modules file error: $OS_ERROR");
   1.242 +		my @dist_info;
   1.243 +		eval { 
   1.244 +			@dist_info = slurp_file( $dist_file );
   1.245 +			1;
   1.246 +		} || PDWiX->throw("CPAN modules file error: $EVAL_ERROR");
   1.247 +
   1.248 +		# Start processing through the distributions that were installed.
   1.249 +		foreach my $dist_info_line (@dist_info) {
   1.250 +			my ($module_name, $dist_installed, $output_file) = split ';', $dist_info_line;
   1.251 +			if ( q{} eq $dist_installed ) {
   1.252 +				$self->_trace_line( 0,
   1.253 +					"Module $module_name was up-to-date\n" );
   1.254 +			} else {
   1.255 +				$self->_add_to_distributions_installed($dist_info);
   1.256 +				push @modules_installed, $module_name;
   1.257 +				if ($packlist_flag) {
   1.258 +					# The filelist is filtered during _search_packlist.
   1.259 +					my $filelist = $self->_search_packlist($module_name, $output_file);					
   1.260 +					$filelists{$module_name} = $filelist;
   1.261 +				} elsif (1 < scalar @dist_info) {
   1.262 +					# Can't pass in 0 to packlist and install more than 1 module.
   1.263 +					PDWiX::Parameter->throw(
   1.264 +						parameter => 'packlist: Cannot be 0 when ' 
   1.265 +						  . 'installing multiple modules at once.',
   1.266 +						where => '::Asset::Module->install',
   1.267 +					);
   1.268 +				} else {
   1.269 +					my $filelist =
   1.270 +					  File::List::Object->new()->readdir( $self->_dir('perl') );
   1.271 +					$filelist->subtract($filelist_sub)->filter( $self->_filters() );
   1.272 +					$filelists{$module_name} = $filelist;
   1.273 +				}
   1.274 +			}
   1.275  		}
   1.276 -		my $dist_info = <$fh>;
   1.277 -		$fh->close;
   1.278 -		$self->_add_to_distributions_installed($dist_info);
   1.279  	} else {
   1.280  		$self->_trace_line( 0,
   1.281 -			"Distribution for module $name was up-to-date\n" );
   1.282 +			"All module(s) $name were up-to-date\n" );
   1.283  	}
   1.284  
   1.285 -	# Making final filelist.
   1.286 -	my $filelist;
   1.287 -	if ($packlist_flag) {
   1.288 -		$filelist = $self->_search_packlist($name);
   1.289 -	} else {
   1.290 -		$filelist =
   1.291 -		  File::List::Object->new()->readdir( $self->_dir('perl') );
   1.292 -		$filelist->subtract($filelist_sub)->filter( $self->_filters() );
   1.293 -	}
   1.294 -
   1.295 -	# Returns the filelist.
   1.296 -	return $filelist;
   1.297 +	# Returns the filelists.
   1.298 +	return \@filelists;
   1.299  } ## end sub install
   1.300  
   1.301  no Moose;
     2.1 --- a/lib/Perl/Dist/WiX/Mixin/Installation.pm	Sun Jun 05 06:40:53 2011 -0600
     2.2 +++ b/lib/Perl/Dist/WiX/Mixin/Installation.pm	Sun Jun 05 21:04:17 2011 -0600
     2.3 @@ -241,27 +241,32 @@
     2.4  	  name => 'DBI',
     2.5    );
     2.6  
     2.7 +  $self->install_module(
     2.8 +	  name => ['DBIx::Class','DBIx::Class::Schema::Loader'],
     2.9 +  );
    2.10 +
    2.11 +  
    2.12  The C<install_module> method is a high level installation method that can
    2.13  be used during the C<install_perl_modules_*> phases, once the CPAN toolchain
    2.14  has been been initialized.
    2.15  
    2.16  It makes the installation call using the CPAN client directly, allowing
    2.17 -the CPAN client to both do the installation and fulfill all of the
    2.18 -dependencies for the module, identically to if it was installed from
    2.19 -the CPAN shell via an "install Module::Name" command.
    2.20 +the CPAN client to do the installation of the module, identically to if 
    2.21 +it was installed from the CPAN shell via an "install Module::Name" command.
    2.22  
    2.23 -The compulsory 'name' param should be the class name of the module to
    2.24 -be installed.
    2.25 +Note that at this point, C<install_module> does NOT install the 
    2.26 +dependencies of the module(s) named - they have to be installed
    2.27 +before the named module, in one way or another.
    2.28  
    2.29 -The optional 'force' param can be used to force the install of module.
    2.30 -This does not, however, force the installation of the dependencies of
    2.31 -the module.
    2.32 +The compulsory 'name' param should be the name of the module(s) to
    2.33 +be installed. Multiple modules must be passed in as an array ref.
    2.34 +
    2.35 +The optional 'force' param can be used to force the install of the 
    2.36 +module(s) named.
    2.37  
    2.38  The optional 'packlist' param should be 0 if a .packlist file is not 
    2.39 -installed with the module.
    2.40 -
    2.41 -This does NOT install the dependencies of the module named - they have
    2.42 -to be installed before the named module, in one way or another.
    2.43 +installed with the module. This is only valid if one module can be 
    2.44 +installed by this call.
    2.45  
    2.46  Returns true or throws an exception on error.
    2.47  
    2.48 @@ -276,16 +281,19 @@
    2.49  		@_,
    2.50  	);
    2.51  
    2.52 -	my $filelist = $module->install();
    2.53 -	my $name     = $module->get_name();
    2.54 -	my $feature  = $module->get_feature();
    2.55 +	my $filelists = $module->install();
    2.56 +	my $feature   = $module->get_feature();
    2.57 +	
    2.58 +	foreach $module_name (keys %{$filelists}) {
    2.59 +		my $filelist = $filelists->{$module_name};
    2.60  
    2.61 -	# Make legal fragment id.
    2.62 -	$name =~ s{::}{_}gmsx;
    2.63 -
    2.64 -	# Insert fragment.
    2.65 -	if ( 0 != scalar @{ $filelist->files } ) {
    2.66 -		$self->insert_fragment( $name, $filelist, 0, $feature );
    2.67 +		# Make legal fragment id.
    2.68 +		$module_name =~ s{::}{_}gmsx;
    2.69 +		
    2.70 +		# Insert fragment.
    2.71 +		if ( 0 != scalar @{ $filelist->files } ) {
    2.72 +			$self->insert_fragment( $module_name, $filelist, 0, $feature );
    2.73 +		}
    2.74  	}
    2.75  
    2.76  	return $self;
     3.1 --- a/lib/Perl/Dist/WiX/Role/NonURLAsset.pm	Sun Jun 05 06:40:53 2011 -0600
     3.2 +++ b/lib/Perl/Dist/WiX/Role/NonURLAsset.pm	Sun Jun 05 21:04:17 2011 -0600
     3.3 @@ -144,7 +144,8 @@
     3.4  
     3.5  
     3.6  sub _search_packlist { ## no critic(ProhibitUnusedPrivateSubroutines)
     3.7 -	my ( $self, $module ) = @_;
     3.8 +	my ( $self, $module, $output ) = @_;
     3.9 +	$output ||= catfile( $self->_get_output_dir(), 'debug.out' );
    3.10  
    3.11  	# We don't use the error until later, if needed.
    3.12  	my $error = <<"EOF";
    3.13 @@ -204,9 +205,8 @@
    3.14  	} else {
    3.15  
    3.16  		# Read the output from installing the module.
    3.17 -		my $output = catfile( $self->_get_output_dir(), 'debug.out' );
    3.18  		$self->_trace_line( 3,
    3.19 -			"Attempting to use debug.out file to make filelist\n" );
    3.20 +			"Attempting to use output file $output to make filelist\n" );
    3.21  		my $fh = IO::File->new( $output, 'r' );
    3.22  
    3.23  		if ( not defined $fh ) {
    3.24 @@ -217,7 +217,7 @@
    3.25  
    3.26  		# Parse the output read in for filenames.
    3.27  		my @files_list =
    3.28 -		  map { ## no critic 'ProhibitComplexMappings'
    3.29 +		  map { ## no critic(ProhibitComplexMappings)
    3.30  			my $t = $_;
    3.31  			chomp $t;
    3.32  			( $t =~ / \A Installing [ ] (.*) \z /msx ) ? ($1) : ();