Perl-Dist-WiX

changeset 1055:6027d640fe54

Starting to eliminate Perl::Dist::WiX::Toolchain.

Also migrating toward Template::Alloy, and extracting out
a large here-string to a template.
author Curtis Jewell <perl@curtisjewell.name>
date Sun Jun 12 19:47:53 2011 -0600 (2011-06-12)
parents 2569a48f8b93
children ef2ef60ce746
files Build.PL lib/Perl/Dist/WiX/Mixin/BuildPerl.pm lib/Perl/Dist/WiX/Mixin/Libraries.pm share/cpan_upgrades.pl.tt
line diff
     1.1 --- a/Build.PL	Sun Jun 12 18:12:56 2011 -0600
     1.2 +++ b/Build.PL	Sun Jun 12 19:47:53 2011 -0600
     1.3 @@ -74,6 +74,7 @@
     1.4  		'Readonly'                   => '1.03',
     1.5  		# Template 2.21 will not install on Windows, anyway.
     1.6  		'Template'                   => '2.22',
     1.7 +		'Template::Alloy'            => '',
     1.8  		'URI'                        => '1.35',
     1.9  		'WiX3'                       => '0.010004',
    1.10  		'YAML::Tiny'                 => '1.36',
     2.1 --- a/lib/Perl/Dist/WiX/Mixin/BuildPerl.pm	Sun Jun 12 18:12:56 2011 -0600
     2.2 +++ b/lib/Perl/Dist/WiX/Mixin/BuildPerl.pm	Sun Jun 12 19:47:53 2011 -0600
     2.3 @@ -27,6 +27,7 @@
     2.4  #<<<
     2.5  use 5.010;
     2.6  use Moose;
     2.7 +use MooseX::Types::Moose              qw( Str ArrayRef );
     2.8  use English                           qw( -no_match_vars );
     2.9  use List::MoreUtils                   qw( any );
    2.10  use Params::Util                      qw( _HASH _STRING _INSTANCE );
    2.11 @@ -37,9 +38,12 @@
    2.12  );
    2.13  use CPAN                       1.9600 qw();
    2.14  use File::List::Object                qw();
    2.15 -use Module::CoreList             2.32 qw();
    2.16 +use Module::CoreList             2.49 qw();
    2.17 +use IO::Capture::Stdout               qw();
    2.18 +use IO::Capture::Stderr               qw();
    2.19  use Perl::Dist::WiX::Asset::Perl      qw();
    2.20 -use Perl::Dist::WiX::Toolchain        qw();
    2.21 +use Template::Alloy                   qw();
    2.22 +#use Perl::Dist::WiX::Toolchain        qw();
    2.23  #>>>
    2.24  
    2.25  our $VERSION = '1.550';
    2.26 @@ -79,6 +83,17 @@
    2.27    Thread::Queue
    2.28  );
    2.29  
    2.30 +has '_perl_toolchain' => (
    2.31 +	traits   => ['Array'],
    2.32 +	is       => 'bare',
    2.33 +	isa      => ArrayRef [Str],
    2.34 +	builder  => '_build_perl_toolchain',
    2.35 +	init_arg => undef,
    2.36 +	lazy     => 1,
    2.37 +	handles  => {
    2.38 +		'_get_toolchain' => 'elements',
    2.39 +	},
    2.40 +);
    2.41  
    2.42  
    2.43  sub _delay_upgrade {
    2.44 @@ -202,35 +217,6 @@
    2.45  				$self->_install_cpan_module( $module, 1 );
    2.46  			}
    2.47  
    2.48 -=for cmt
    2.49 -			# There's a problem with extracting these two files, so
    2.50 -			# upgrading to these versions, instead...
    2.51 -			## no critic(ProhibitUnusedCapture)
    2.52 -			when (
    2.53 -				m{Unicode-Collate-0 [.] (\d\d)
    2.54 -                   -withoutworldwriteables}msx
    2.55 -			  )
    2.56 -			{
    2.57 -				$self->install_distribution(
    2.58 -					name     => "SADAHIRO/Unicode-Collate-0.$1.tar.gz",
    2.59 -					mod_name => 'Unicode::Collate',
    2.60 -					$self->_install_location(1),
    2.61 -					$self->_force_flag($default_force),
    2.62 -				);
    2.63 -			} ## end when ( m{Unicode-Collate-0 [.] (\d\d) })
    2.64 -
    2.65 -			when (
    2.66 -				/Unicode-Normalize-1 [.] (\d\d)-withoutworldwriteables/msx)
    2.67 -			{
    2.68 -				$self->install_distribution(
    2.69 -					name     => "SADAHIRO/Unicode-Normalize-1.$1.tar.gz",
    2.70 -					mod_name => 'Unicode::Normalize',
    2.71 -					$self->_install_location(1),
    2.72 -					$self->_force_flag($default_force),
    2.73 -				);
    2.74 -			}
    2.75 -=cut
    2.76 -
    2.77  			when (m{/ExtUtils-MakeMaker-\d}msx) {
    2.78  
    2.79     # Get rid of the old ExtUtils::MakeMaker files that were deleted in 6.50.
    2.80 @@ -318,103 +304,27 @@
    2.81  sub _get_cpan_upgrades_list {
    2.82  	my $self = shift;
    2.83  
    2.84 -	# Get the CPAN url.
    2.85 -	my $url = $self->cpan()->as_string();
    2.86 +	# Generate the CPAN installation script
    2.87 +	$self->trace_line( 1, "Running upgrade of all modules\n" );
    2.88 +	my $cpan_info_file = $self->output_dir()->file('cpan.info')->stringify();
    2.89 +	my $cpan_file = $self->build_dir()->file('cpan_string.pl')->stringify();
    2.90 +	my $tt = Template::Alloy->new(ABSOLUTE => 1,);
    2.91 +	my $tt_answer = $tt->process(
    2.92 +		$self->wix_dist_dir()->file('cpan_upgrades.pl.tt'), 
    2.93 +		{
    2.94 +			url            => $self->cpan()->as_string(),
    2.95 +			cpan_info_file => $cpan_info_file,
    2.96 +		}, 
    2.97 +		$cpan_file,
    2.98 +	);
    2.99  
   2.100 -	# Generate the CPAN installation script
   2.101 -	my $cpan_string = <<"END_PERL";
   2.102 -print "Loading CPAN...\\n";
   2.103 -use CPAN 1.9600;
   2.104 -CPAN::HandleConfig->load unless \$CPAN::Config_loaded++;
   2.105 -\$CPAN::Config->{'urllist'} = [ '$url' ];
   2.106 -END_PERL
   2.107 -	$cpan_string .= <<'END_PERL';
   2.108 -print "Loading Storable...\n";
   2.109 -use Storable qw(nstore);
   2.110 +	if ( not $tt_answer ) {
   2.111 +		PDWiX::Caught->throw(
   2.112 +			info    => 'Template',
   2.113 +			message => $tt->error()->as_string() );
   2.114 +	}
   2.115  
   2.116 -my ($module, %seen, %need, @toget);
   2.117 -	
   2.118 -my @modulelist = CPAN::Shell->expand('Module', '/./');
   2.119 -
   2.120 -# Schwartzian transform from CPAN.pm.
   2.121 -my @expand;
   2.122 -@expand = map {
   2.123 -	$_->[1]
   2.124 -} sort {
   2.125 -	$b->[0] <=> $a->[0]
   2.126 -	||
   2.127 -	$a->[1]{ID} cmp $b->[1]{ID},
   2.128 -} map {
   2.129 -	[$_->_is_representative_module,
   2.130 -	 $_
   2.131 -	]
   2.132 -} @modulelist;
   2.133 -
   2.134 -require Config;
   2.135 -my $vendorlib=$Config::Config{'installvendorlib'};
   2.136 -MODULE: for $module (@expand) {
   2.137 -	my $file = $module->cpan_file;
   2.138 -	
   2.139 -	# If there's no file to download, skip it.
   2.140 -	next MODULE unless defined $file;
   2.141 -
   2.142 -	$file =~ s{^./../}{};
   2.143 -	my $latest  = $module->cpan_version;
   2.144 -	my $inst_file = $module->inst_file;
   2.145 -	my $have;
   2.146 -	my $next_MODULE;
   2.147 -	eval { # version.pm involved!
   2.148 -		if ($inst_file and $vendorlib ne substr($inst_file,0,length($vendorlib))) {
   2.149 -			$have = $module->inst_version;
   2.150 -			local $^W = 0;
   2.151 -			++$next_MODULE unless CPAN::Version->vgt($latest, $have);
   2.152 -			# to be pedantic we should probably say:
   2.153 -			#    && !($have eq "undef" && $latest ne "undef" && $latest gt "");
   2.154 -			# to catch the case where CPAN has a version 0 and we have a version undef
   2.155 -		} else {
   2.156 -		   ++$next_MODULE;
   2.157 -		}
   2.158 -	};
   2.159 -
   2.160 -	next MODULE if $next_MODULE;
   2.161 -	
   2.162 -	if ($@) {
   2.163 -		next MODULE;
   2.164 -	}
   2.165 -	
   2.166 -	$seen{$file} ||= 0;
   2.167 -	next MODULE if $seen{$file}++;
   2.168 -	
   2.169 -	push @toget, $module;
   2.170 -	
   2.171 -	$need{$module->id}++;
   2.172 -}
   2.173 -
   2.174 -unless (%need) {
   2.175 -	print "All modules are up to date\n";
   2.176 -}
   2.177 -	
   2.178 -END_PERL
   2.179 -	my $cpan_info_file = catfile( $self->output_dir(), 'cpan.info' );
   2.180 -	$cpan_string .= <<"END_PERL";
   2.181 -nstore \\\@toget, '$cpan_info_file';
   2.182 -print "Completed collecting information on all modules\\n";
   2.183 -
   2.184 -exit 0;
   2.185 -END_PERL
   2.186 -
   2.187 -	# Dump the CPAN script to a temp file and execute.
   2.188 -	$self->trace_line( 1, "Running upgrade of all modules\n" );
   2.189 -	my $cpan_file = catfile( $self->build_dir(), 'cpan_string.pl' );
   2.190 -  SCOPE: {
   2.191 -		my $CPAN_FILE;
   2.192 -		open $CPAN_FILE, '>', $cpan_file
   2.193 -		  or PDWiX->throw("CPAN script open failed: $OS_ERROR");
   2.194 -		print {$CPAN_FILE} $cpan_string
   2.195 -		  or PDWiX->throw("CPAN script print failed: $OS_ERROR");
   2.196 -		close $CPAN_FILE
   2.197 -		  or PDWiX->throw("CPAN script close failed: $OS_ERROR");
   2.198 -	}
   2.199 +	# Execute the CPAN upgrade script.
   2.200  	$self->execute_perl($cpan_file)
   2.201  	  or PDWiX->throw('CPAN script execution failed');
   2.202  	if ($CHILD_ERROR) {
   2.203 @@ -566,6 +476,9 @@
   2.204  	return PDWiX::Unimplemented->throw();
   2.205  }
   2.206  
   2.207 +sub _get_forced_toolchain_dists {
   2.208 +	return PDWiX::Unimplemented->throw();
   2.209 +}
   2.210  
   2.211  
   2.212  sub _find_perl_file { ## no critic(ProhibitUnusedPrivateSubroutines)
   2.213 @@ -574,8 +487,7 @@
   2.214  
   2.215  
   2.216  
   2.217 -# This routine is called by the _install_perl_plugin routines.
   2.218 -sub _create_perl_toolchain { ## no critic(ProhibitUnusedPrivateSubroutines)
   2.219 +sub _build_perl_toolchain { ## no critic(ProhibitUnusedPrivateSubroutines)
   2.220  	my $self = shift;
   2.221  	my $cpan = $self->cpan();
   2.222  
   2.223 @@ -589,43 +501,84 @@
   2.224  		}
   2.225  	}
   2.226  
   2.227 -	# Prefetch and predelegate the toolchain so that it
   2.228 -	# fails early if there's a problem
   2.229 -	$self->trace_line( 1, "Pregenerating toolchain...\n" );
   2.230 -	my $force = {};
   2.231 -	if ( $self->perl_version =~ m/\A512/ms ) {
   2.232 -		$force = { 'Pod::Text' => 'RRA/podlators-2.4.0.tar.gz' };
   2.233 -	}
   2.234 +	$self->trace_line( 1, "Generating toolchain...\n" );
   2.235 +	my $force = $self->_get_forced_toolchain_dists();
   2.236  	$force->{'ExtUtils::MakeMaker'} =
   2.237  	  'MSCHWERN/ExtUtils-MakeMaker-6.57_11.tar.gz';
   2.238 +	# New version of LWP creates problems for https on 64 bit systems
   2.239  	$force->{'LWP'} = 'GAAS/libwww-perl-5.837.tar.gz';
   2.240  
   2.241 -	#new version creates problems for https on 64 bit systems
   2.242 +	my $corelist_version = $self->perl_version_literal() + 0;
   2.243 +	my $corelist_hash    = $Module::CoreList::version{$corelist_version};
   2.244 +	my @dists;
   2.245  
   2.246 -	my $toolchain = Perl::Dist::WiX::Toolchain->new(
   2.247 -		perl_version => $self->perl_version_literal(),
   2.248 -		cpan         => $cpan->as_string(),
   2.249 -		bits         => $self->bits(),
   2.250 -		force        => $force,
   2.251 -	) or PDWiX->throw('Failed to resolve toolchain modules');
   2.252 -	if ( not eval { $toolchain->delegate(); 1; } ) {
   2.253 -		PDWiX::Caught->throw(
   2.254 -			message => 'Delegation error occured',
   2.255 -			info    => defined($EVAL_ERROR) ? $EVAL_ERROR : 'Unknown error',
   2.256 -		);
   2.257 +	my $stdout = IO::Capture::Stdout->new();
   2.258 +	my $stderr = IO::Capture::Stderr->new();
   2.259 +	$stdout->start();
   2.260 +	$stderr->start();
   2.261 +
   2.262 +	# Load the latest index
   2.263 +	local $SIG{__WARN__} = sub {1};
   2.264 +	if ( not $CPAN::Config_loaded++ ) {
   2.265 +		CPAN::HandleConfig->load();
   2.266  	}
   2.267 -	if ( defined $toolchain->get_error() ) {
   2.268 -		PDWiX::Caught->throw(
   2.269 -			message => 'Failed to generate toolchain distributions',
   2.270 -			info    => $toolchain->get_error() );
   2.271 -	}
   2.272 +	$CPAN::Config->{'urllist'}    = [ $self->_get_cpan() ];
   2.273 +	$CPAN::Config->{'use_sqlite'} = q[0];
   2.274 +	CPAN::Index->reload();
   2.275  
   2.276 -	$self->_set_toolchain($toolchain);
   2.277 +	foreach
   2.278 +	  my $name ( @{ $self->_toolchain_modules() } )
   2.279 +	{
   2.280 +		# Shortcut if forced
   2.281 +		if ( $force->{$name} ) {
   2.282 +			push @dists, $force->{$name};
   2.283 +			next;
   2.284 +		}
   2.285  
   2.286 -	# Make the perl directory if it hasn't been made already.
   2.287 -	$self->make_path( $self->dir('perl') );
   2.288 +		# Get the CPAN object for the module, covering any output.
   2.289 +		my $module = CPAN::Shell->expand( 'Module', $name );
   2.290  
   2.291 -	return $toolchain;
   2.292 +		if ( not $module ) {
   2.293 +			$stdout->stop();
   2.294 +			$stderr->stop();
   2.295 +			PDWiX->throw("Failed to find '$name'");
   2.296 +		}
   2.297 +
   2.298 +		# Ignore modules that don't need to be updated
   2.299 +		my $core_version = $corelist_hash->{$name};
   2.300 +		if ( defined $core_version and $core_version =~ /_/ms ) {
   2.301 +
   2.302 +			# Sometimes, the core contains a developer
   2.303 +			# version. For the purposes of this comparison
   2.304 +			# it should be safe to "round down".
   2.305 +			$core_version =~ s{_.+}{}ms;
   2.306 +		}
   2.307 +		my $cpan_version = $module->cpan_version;
   2.308 +		if ( not defined $cpan_version ) {
   2.309 +			next;
   2.310 +		}
   2.311 +		if ( defined $core_version and $core_version >= $cpan_version ) {
   2.312 +			next;
   2.313 +		}
   2.314 +
   2.315 +		# Filter out already seen dists
   2.316 +		my $file = $module->cpan_file;
   2.317 +		$file =~ s{\A [[:upper:]] / [[:upper:]][[:upper:]] /}{}msx;
   2.318 +		push @dists, $file;
   2.319 +	} ## end foreach my $name ( @{ $self...})
   2.320 +
   2.321 +	$stdout->stop();
   2.322 +	$stderr->stop();
   2.323 +	
   2.324 +	# Remove duplicates.
   2.325 +	my %seen = ();
   2.326 +	my @final_dists = grep { !$seen{$_}++ } @dists;
   2.327 +	
   2.328 +	my $s = join "\n    ", 'List of toolchain dists:', @final_dists; 
   2.329 +	$self->trace_line(1, "$s\n");
   2.330 +	PDWiX::Stop->throw();
   2.331 +	
   2.332 +	return \@final_dists;
   2.333  } ## end sub _create_perl_toolchain
   2.334  
   2.335  
     3.1 --- a/lib/Perl/Dist/WiX/Mixin/Libraries.pm	Sun Jun 12 18:12:56 2011 -0600
     3.2 +++ b/lib/Perl/Dist/WiX/Mixin/Libraries.pm	Sun Jun 12 19:47:53 2011 -0600
     3.3 @@ -26,8 +26,9 @@
     3.4  
     3.5  use 5.010;
     3.6  use Moose;
     3.7 -use File::Spec::Functions qw( catfile );
     3.8 -use Params::Util qw( _STRING );
     3.9 +use MooseX::Types::Moose            qw( Str HashRef );
    3.10 +use File::Spec::Functions           qw( catfile );
    3.11 +use Params::Util                    qw( _STRING );
    3.12  use Perl::Dist::WiX::Exceptions;
    3.13  use Readonly;
    3.14  
    3.15 @@ -67,7 +68,7 @@
    3.16  
    3.17  has '_library_information' => (
    3.18  	is       => 'ro',
    3.19 -	isa      => HashRef[ Str ],
    3.20 +	isa      => HashRef [ Str ],
    3.21  	init_arg => undef,
    3.22  	lazy     => 1,
    3.23  	builder  => '_build_library_information',
    3.24 @@ -79,6 +80,7 @@
    3.25  }
    3.26  
    3.27  
    3.28 +
    3.29  =pod
    3.30  
    3.31  =head2 library_directory
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/share/cpan_upgrades.pl.tt	Sun Jun 12 19:47:53 2011 -0600
     4.3 @@ -0,0 +1,77 @@
     4.4 +#!perl
     4.5 +
     4.6 +print "Loading CPAN...\n";
     4.7 +use CPAN 1.9600;
     4.8 +CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
     4.9 +$CPAN::Config->{'urllist'} = [ '[% url %]' ];
    4.10 +
    4.11 +print "Loading Storable...\n";
    4.12 +use Storable qw(nstore);
    4.13 +
    4.14 +my ($module, %seen, %need, @toget);
    4.15 +	
    4.16 +my @modulelist = CPAN::Shell->expand('Module', '/./');
    4.17 +
    4.18 +# Schwartzian transform from CPAN.pm.
    4.19 +my @expand;
    4.20 +@expand = map {
    4.21 +	$_->[1]
    4.22 +} sort {
    4.23 +	$b->[0] <=> $a->[0]
    4.24 +	||
    4.25 +	$a->[1]{ID} cmp $b->[1]{ID},
    4.26 +} map {
    4.27 +	[$_->_is_representative_module,
    4.28 +	 $_
    4.29 +	]
    4.30 +} @modulelist;
    4.31 +
    4.32 +require Config;
    4.33 +my $vendorlib=$Config::Config{'installvendorlib'};
    4.34 +MODULE: for $module (@expand) {
    4.35 +	my $file = $module->cpan_file;
    4.36 +	
    4.37 +	# If there's no file to download, skip it.
    4.38 +	next MODULE unless defined $file;
    4.39 +
    4.40 +	$file =~ s{^./../}{};
    4.41 +	my $latest  = $module->cpan_version;
    4.42 +	my $inst_file = $module->inst_file;
    4.43 +	my $have;
    4.44 +	my $next_MODULE;
    4.45 +	eval { # version.pm involved!
    4.46 +		if ($inst_file and $vendorlib ne substr($inst_file,0,length($vendorlib))) {
    4.47 +			$have = $module->inst_version;
    4.48 +			local $^W = 0;
    4.49 +			++$next_MODULE unless CPAN::Version->vgt($latest, $have);
    4.50 +			# to be pedantic we should probably say:
    4.51 +			#    && !($have eq "undef" && $latest ne "undef" && $latest gt "");
    4.52 +			# to catch the case where CPAN has a version 0 and we have a version undef
    4.53 +		} else {
    4.54 +		   ++$next_MODULE;
    4.55 +		}
    4.56 +	};
    4.57 +
    4.58 +	next MODULE if $next_MODULE;
    4.59 +	
    4.60 +	if ($@) {
    4.61 +		next MODULE;
    4.62 +	}
    4.63 +	
    4.64 +	$seen{$file} ||= 0;
    4.65 +	next MODULE if $seen{$file}++;
    4.66 +	
    4.67 +	push @toget, $module;
    4.68 +	
    4.69 +	$need{$module->id}++;
    4.70 +}
    4.71 +
    4.72 +unless (%need) {
    4.73 +	print "All modules are up to date\n";
    4.74 +}
    4.75 +
    4.76 +nstore \@toget, '[% cpan_info_file %]';
    4.77 +print "Completed collecting information on all modules\\n";
    4.78 +
    4.79 +exit 0;
    4.80 +