Perl-Dist-WiX

changeset 1069:36b724454db4

Implementing case-fixing.
author Curtis Jewell <perl@curtisjewell.name>
date Thu Jun 23 22:28:13 2011 -0600 (2011-06-23)
parents a006394b0189
children 9ea81114262e
files lib/Perl/Dist/WiX/Asset/Distribution.pm lib/Perl/Dist/WiX/Mixin/BuildPerl.pm
line diff
     1.1 --- a/lib/Perl/Dist/WiX/Asset/Distribution.pm	Tue Jun 21 23:27:56 2011 -0600
     1.2 +++ b/lib/Perl/Dist/WiX/Asset/Distribution.pm	Thu Jun 23 22:28:13 2011 -0600
     1.3 @@ -54,6 +54,7 @@
     1.4  use File::Spec::Functions  qw( catdir catfile );
     1.5  use Params::Util           qw( _INSTANCE );
     1.6  use URI                    qw();
     1.7 +use Win32                  qw();
     1.8  
     1.9  our $VERSION = '1.550';
    1.10  
    1.11 @@ -271,6 +272,33 @@
    1.12  
    1.13  
    1.14  
    1.15 +=head3 case_fix
    1.16 +
    1.17 +Some distributions (C<Version::Requirements>, for example) install files
    1.18 +in directories that end up conflicting in case with previous distributions. 
    1.19 +(in this case, with the C<version> module.)
    1.20 +Since Windows is case-preserving, yet case-insensitive, that means the case
    1.21 +of the directory is determined by the module that is installed first.
    1.22 +
    1.23 +The optional C<case_fix> param lets you specify that this is the second 
    1.24 +distribution installed in such a pair, and tries harder (by calling 
    1.25 +C<Win32::GetLongFileName() on each file) to add the filenames to the list 
    1.26 +of files installed in the correct case. This defaults to false, for speed
    1.27 +optimization reasons.
    1.28 +
    1.29 +=cut
    1.30 +
    1.31 +
    1.32 +
    1.33 +has case_fix => (
    1.34 +	is      => 'ro',
    1.35 +	isa     => Bool,
    1.36 +	reader  => '_get_case_fix',
    1.37 +	default => 0,
    1.38 +);
    1.39 +
    1.40 +
    1.41 +
    1.42  sub BUILDARGS {
    1.43  	my $class = shift;
    1.44  	my %args;
    1.45 @@ -474,6 +502,17 @@
    1.46  		$filelist->subtract($filelist_sub)->filter( $self->_filters() );
    1.47  	}
    1.48  
    1.49 +	if ( $self->_get_case_fix() ) {
    1.50 +		my @files = @{ $filelist->files() };
    1.51 +		my @correct_files;
    1.52 +		foreach my $file (@files) {
    1.53 +			my $fixed_file = Win32::GetLongPathName($file);
    1.54 +			$self->_trace_line(5, "Case fixing:\n  OLD: $file\n  NEW: $fixed_file\n");
    1.55 +			push @correct_files, $fixed_file;
    1.56 +		}
    1.57 +		$filelist = File::List::Object->new()->load_array(@correct_files);
    1.58 +	}
    1.59 +	
    1.60  	my $module_name = $self->get_module_name();
    1.61  	$module_name =~ s{::}{_}msg;
    1.62  	$module_name =~ s{-}{_}msg;
     2.1 --- a/lib/Perl/Dist/WiX/Mixin/BuildPerl.pm	Tue Jun 21 23:27:56 2011 -0600
     2.2 +++ b/lib/Perl/Dist/WiX/Mixin/BuildPerl.pm	Thu Jun 23 22:28:13 2011 -0600
     2.3 @@ -604,6 +604,7 @@
     2.4  		my $automated_testing = 0;
     2.5  		my $release_testing   = 0;
     2.6  		my $overwritable      = 0;
     2.7 +		my $casefix           = 0;
     2.8  		my $force             = $default_force;
     2.9  		# Actually DO the installation, now
    2.10  		# that we've got the information we need.
    2.11 @@ -659,6 +660,8 @@
    2.12  
    2.13  				# There are modules that overwrite portions of this one.
    2.14  				$overwritable = 1;
    2.15 +				# Must be in core.
    2.16 +				$core = 1;
    2.17  			}
    2.18  			when (/Win32API-Registry-/msx) {
    2.19  
    2.20 @@ -695,14 +698,24 @@
    2.21  				$core = 1;
    2.22  
    2.23  			}
    2.24 +			when (/version-/msx) {
    2.25 +
    2.26 +				# Messes up case when added.
    2.27 +				$casefix = 1;
    2.28 +
    2.29 +			}
    2.30  			when (/Version-Requirements-/msx) {
    2.31  
    2.32  				# Must be in core to overwrite EU::MM's version.
    2.33  				$core = 1;
    2.34 +				# Messes up case when added.
    2.35 +				$casefix = 1;
    2.36  
    2.37  			}
    2.38  		} ## end given
    2.39  
    2.40 +		my $mod_name = $self->_packlist_fix($module_id);
    2.41 +		$self->trace_line(5, "Module determined to be $mod_name\n");
    2.42  #<<<
    2.43  		$self->install_distribution(
    2.44  			name              => $dist,
    2.45 @@ -711,6 +724,7 @@
    2.46  			automated_testing => $automated_testing,
    2.47  			release_testing   => $release_testing,
    2.48  			overwritable      => $overwritable,
    2.49 +			case_fix          => $casefix,
    2.50  			$self->_install_location($core),
    2.51  		);
    2.52  #>>>