Perl-Dist-WiX

changeset 1070:9ea81114262e

Get rid of undefined errors and instrument packlist finding.
author Curtis Jewell <perl@curtisjewell.name>
date Sun Jun 26 02:23:54 2011 -0600 (2011-06-26)
parents 36b724454db4
children 42cb18facbe6
files lib/Perl/Dist/WiX/Asset/Distribution.pm lib/Perl/Dist/WiX/Role/Asset.pm lib/Perl/Dist/WiX/Role/NonURLAsset.pm
line diff
     1.1 --- a/lib/Perl/Dist/WiX/Asset/Distribution.pm	Thu Jun 23 22:28:13 2011 -0600
     1.2 +++ b/lib/Perl/Dist/WiX/Asset/Distribution.pm	Sun Jun 26 02:23:54 2011 -0600
     1.3 @@ -399,7 +399,7 @@
     1.4  	my $module = $self->get_module_name();
     1.5  	my $filelist_sub;
     1.6  
     1.7 -	if ( not $self->_get_packlist() ) {
     1.8 +	if ( not $self->_get_packlist($module, $name) ) {
     1.9  		$filelist_sub =
    1.10  		  File::List::Object->new->readdir( $self->_dir('perl') );
    1.11  		$self->_trace_line( 5,
     2.1 --- a/lib/Perl/Dist/WiX/Role/Asset.pm	Thu Jun 23 22:28:13 2011 -0600
     2.2 +++ b/lib/Perl/Dist/WiX/Role/Asset.pm	Sun Jun 26 02:23:54 2011 -0600
     2.3 @@ -267,7 +267,7 @@
     2.4  
     2.5  
     2.6  sub _search_packlist { ## no critic(ProhibitUnusedPrivateSubroutines)
     2.7 -	my ( $self, $module ) = @_;
     2.8 +	my ( $self, $module, $dist_installed ) = @_;
     2.9  
    2.10  	# We don't use the error until later, if needed.
    2.11  	my $error = <<"EOF";
    2.12 @@ -281,6 +281,18 @@
    2.13  EOF
    2.14  	chomp $error;
    2.15  
    2.16 +	$dist_installed = '' if not $dist_installed;
    2.17 +	# Try and get a second module name to try from the name of the
    2.18 +	# distribution's tarball.
    2.19 +	my ($second_module) = $dist_installed =~ m{ 
    2.20 +		/ ([^/]*)            # Grab whatever's after the last slash ...
    2.21 +		-\d+(?:.*)           # up to the first thing that starts with a digit ...
    2.22 +		\.                   # and then match a dot ...
    2.23 +		(?:tar\.gz|tgz|zip)  # and then an extension ...
    2.24 +		\z                   # that ends the string.
    2.25 +	}msx;
    2.26 +	$second_module =~ s/-/::/msg if $second_module;
    2.27 +	
    2.28  	# Get all the filenames and directory names required.
    2.29  	my $image_dir   = $self->_get_image_dir();
    2.30  	my @module_dirs = split /::/ms, $module;
    2.31 @@ -290,6 +302,16 @@
    2.32  		catdir( $image_dir, qw{perl        lib auto}, @module_dirs ),
    2.33  	);
    2.34  
    2.35 +	# If the second name wasn't equal to the first, try and get it.
    2.36 +	if ($second_module && ($second_module ne $module)) {
    2.37 +		my @second_module_dirs = split /::/ms, $second_module;
    2.38 +		push @dirs, (
    2.39 +			catdir( $image_dir, qw{perl vendor lib auto}, @second_module_dirs ),
    2.40 +			catdir( $image_dir, qw{perl site   lib auto}, @second_module_dirs ),
    2.41 +			catdir( $image_dir, qw{perl        lib auto}, @second_module_dirs ),
    2.42 +		);
    2.43 +	}
    2.44 +
    2.45  	my $packlist_location = $self->_get_packlist_location();
    2.46  	if ( defined $packlist_location ) {
    2.47  		push @dirs,
    2.48 @@ -314,6 +336,7 @@
    2.49    DIR:
    2.50  	foreach my $dir (@dirs) {
    2.51  		$packlist = catfile( $dir, '.packlist' );
    2.52 +		$self->_trace_line(1, "Checking for $packlist\n"); # 4
    2.53  		last DIR if -r $packlist;
    2.54  	}
    2.55  
    2.56 @@ -321,6 +344,7 @@
    2.57  	if ( -r $packlist ) {
    2.58  
    2.59  		# Load a filelist object from the packlist if one exists.
    2.60 +		$self->_trace_line(1, "$packlist was found\n"); # 3
    2.61  		$filelist =
    2.62  		  File::List::Object->new()->load_file($packlist)
    2.63  		  ->add_file($packlist);
     3.1 --- a/lib/Perl/Dist/WiX/Role/NonURLAsset.pm	Thu Jun 23 22:28:13 2011 -0600
     3.2 +++ b/lib/Perl/Dist/WiX/Role/NonURLAsset.pm	Sun Jun 26 02:23:54 2011 -0600
     3.3 @@ -156,7 +156,7 @@
     3.4  		(?:tar\.gz|tgz|zip)  # and then an extension ...
     3.5  		\z                   # that ends the string.
     3.6  	}msx;
     3.7 -	$second_module =~ s/-/::/msg;
     3.8 +	$second_module =~ s/-/::/msg if $second_module;
     3.9  	
    3.10  	# We don't use the error until later, if needed.
    3.11  	my $error = <<"EOF";
    3.12 @@ -180,7 +180,7 @@
    3.13  	);
    3.14  
    3.15  	# If the second name wasn't equal to the first, try and get it.
    3.16 -	if ($second_module ne $module) {
    3.17 +	if ($second_module && ($second_module ne $module)) {
    3.18  		my @second_module_dirs = split /::/ms, $second_module;
    3.19  		push @dirs, (
    3.20  			catdir( $image_dir, qw{perl vendor lib auto}, @second_module_dirs ),
    3.21 @@ -188,7 +188,7 @@
    3.22  			catdir( $image_dir, qw{perl        lib auto}, @second_module_dirs ),
    3.23  		);
    3.24  	}
    3.25 -	
    3.26 +
    3.27  	# If we were given a packlist location, try there, first!
    3.28  	my $packlist_location = $self->_get_packlist_location();
    3.29  	if ( defined $packlist_location ) {