X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Flocal%2Flib.pm;h=2e477e66465043896e0a0ceb01f7dadac9d8ba0a;hb=1cd322bb6bfa4218fc286b356ee72a83ac8e18e1;hp=5f2d981525f84977da44708d87d9a793095f1e5d;hpb=82efaec712035098a31ded335c001b3b4884ffe5;p=p5sagit%2Flocal-lib.git diff --git a/lib/local/lib.pm b/lib/local/lib.pm index 5f2d981..2e477e6 100644 --- a/lib/local/lib.pm +++ b/lib/local/lib.pm @@ -8,10 +8,9 @@ use 5.008001; # probably works with earlier versions but I'm not supporting them use File::Spec (); use File::Path (); -use Carp (); use Config; -our $VERSION = '1.008003'; # 1.8.3 +our $VERSION = '1.008011'; # 1.8.11 our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all); @@ -175,6 +174,7 @@ sub resolve_home_path { } }; unless (defined $homedir) { + require Carp; Carp::croak( "Couldn't resolve homedir for " .(defined $user ? $user : 'current user') @@ -207,7 +207,13 @@ sub setup_local_lib_for { my $interpolate = LITERAL_ENV; my @active_lls = $class->active_paths; - $path = $class->ensure_dir_structure_for($path); + $class->ensure_dir_structure_for($path); + + # On Win32 directories often contain spaces. But some parts of the CPAN + # toolchain don't like that. To avoid this, GetShortPathName() gives us + # an alternate representation that has none. + # This only works if the directory already exists. + $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32'; if (! $deactivating) { if (@active_lls && $active_lls[-1] eq $path) { @@ -228,7 +234,15 @@ sub setup_local_lib_for { exit 0; } else { $class->setup_env_hash_for($path, $deactivating); - @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC); + my $arch_dir = $Config{archname}; + @INC = _uniq( + ( + # Inject $path/$archname for each path in PERL5LIB + map { ( File::Spec->catdir($_, $arch_dir), $_ ) } + split($Config{path_sep}, $ENV{PERL5LIB}) + ), + @INC + ); } } @@ -253,11 +267,7 @@ sub ensure_dir_structure_for { warn "Attempting to create directory ${path}\n"; } File::Path::mkpath($path); - # Need to have the path exist to make a short name for it, so - # converting to a short name here. - $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32'; - - return $path; + return } sub guess_shelltype { @@ -360,35 +370,71 @@ sub build_environment_vars_for { } } +# Build an environment value for a variable like PATH from a list of paths. +# References to existing variables are given as references to the variable name. +# Duplicates are removed. +# +# options: +# - interpolate: INTERPOLATE_ENV/LITERAL_ENV +# - exists: paths are included only if they exist (default: interpolate == INTERPOLATE_ENV) +# - filter: function to apply to each path do decide if it must be included +# - empty: the value to return in the case of empty value +my %ENV_LIST_VALUE_DEFAULTS = ( + interpolate => INTERPOLATE_ENV, + exists => undef, + filter => sub { 1 }, + empty => undef, +); +sub _env_list_value { + my $options = shift; + die(sprintf "unknown option '$_' at %s line %u\n", (caller)[1..2]) + for grep { !exists $ENV_LIST_VALUE_DEFAULTS{$_} } keys %$options; + my %options = (%ENV_LIST_VALUE_DEFAULTS, %{ $options }); + $options{exists} = $options{interpolate} == INTERPOLATE_ENV + unless defined $options{exists}; + + my %seen; + + my $value = join($Config{path_sep}, map { + ref $_ ? ($^O eq 'MSWin32' ? "%${$_}%" : "\$${$_}") : $_ + } grep { + ref $_ || (defined $_ + && length($_) > 0 + && !$seen{$_}++ + && $options{filter}->($_) + && (!$options{exists} || -e $_)) + } map { + if (ref $_ eq 'SCALAR' && $options{interpolate} == INTERPOLATE_ENV) { + defined $ENV{${$_}} ? (split /\Q$Config{path_sep}/, $ENV{${$_}}) : () + } else { + $_ + } + } @_); + return length($value) ? $value : $options{empty}; +} + sub build_activate_environment_vars_for { my ($class, $path, $interpolate) = @_; return ( - PERL_LOCAL_LIB_ROOT => join($Config{path_sep}, - (($ENV{PERL_LOCAL_LIB_ROOT}||()) ? - ($interpolate == INTERPOLATE_ENV - ? ($ENV{PERL_LOCAL_LIB_ROOT}||()) - : (($^O ne 'MSWin32') ? '$PERL_LOCAL_LIB_ROOT' - : '%PERL_LOCAL_LIB_ROOT%' )) - : ()), - $path + PERL_LOCAL_LIB_ROOT => + _env_list_value( + { interpolate => $interpolate, exists => 0, empty => '' }, + \'PERL_LOCAL_LIB_ROOT', + $path, ), PERL_MB_OPT => "--install_base ${path}", PERL_MM_OPT => "INSTALL_BASE=${path}", - PERL5LIB => join($Config{path_sep}, - $class->install_base_arch_path($path), - $class->install_base_perl_path($path), - (($ENV{PERL5LIB}||()) ? - ($interpolate == INTERPOLATE_ENV - ? ($ENV{PERL5LIB}) - : (($^O ne 'MSWin32') ? '$PERL5LIB' : '%PERL5LIB%' )) - : ()) - ), - PATH => join($Config{path_sep}, - $class->install_base_bin_path($path), - ($interpolate == INTERPOLATE_ENV - ? ($ENV{PATH}||()) - : (($^O ne 'MSWin32') ? '$PATH' : '%PATH%' )) - ), + PERL5LIB => + _env_list_value( + { interpolate => $interpolate, exists => 0, empty => '' }, + $class->install_base_perl_path($path), + \'PERL5LIB', + ), + PATH => _env_list_value( + { interpolate => $interpolate, exists => 0, empty => '' }, + $class->install_base_bin_path($path), + \'PATH', + ), ) } @@ -396,7 +442,7 @@ sub active_paths { my ($class) = @_; return () unless defined $ENV{PERL_LOCAL_LIB_ROOT}; - return split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT}; + return grep { $_ ne '' } split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT}; } sub build_deactivate_environment_vars_for { @@ -409,40 +455,42 @@ sub build_deactivate_environment_vars_for { return (); } - my @new_ll_root = grep { $_ ne $path } @active_lls; - my @new_perl5lib = grep { - $_ ne $class->install_base_arch_path($path) && - $_ ne $class->install_base_perl_path($path) - } split /\Q$Config{path_sep}/, $ENV{PERL5LIB}; + my $perl_path = $class->install_base_perl_path($path); + my $arch_path = $class->install_base_arch_path($path); + my $bin_path = $class->install_base_bin_path($path); + my %env = ( - PERL_LOCAL_LIB_ROOT => (@new_ll_root ? - join($Config{path_sep}, @new_ll_root) : undef + PERL_LOCAL_LIB_ROOT => _env_list_value( + { + exists => 0, + }, + grep { $_ ne $path } @active_lls ), - PERL5LIB => (@new_perl5lib ? - join($Config{path_sep}, @new_perl5lib) : undef + PERL5LIB => _env_list_value( + { + exists => 0, + filter => sub { + $_ ne $perl_path && $_ ne $arch_path + }, + }, + \'PERL5LIB', ), - PATH => join($Config{path_sep}, - grep { $_ ne $class->install_base_bin_path($path) } - split /\Q$Config{path_sep}/, $ENV{PATH} + PATH => _env_list_value( + { + exists => 0, + filter => sub { $_ ne $bin_path }, + }, + \'PATH', ), ); # If removing ourselves from the "top of the stack", set install paths to # correspond with the new top of stack. if ($active_lls[-1] eq $path) { - if (@active_lls > 1) { - my $new_top = $active_lls[-2]; - %env = (%env, - PERL_MB_OPT => "--install_base ${new_top}", - PERL_MM_OPT => "INSTALL_BASE=${new_top}", - ); - } else { - %env = (%env, - PERL_MB_OPT => undef, - PERL_MM_OPT => undef, - ); - } + my $new_top = $active_lls[-2]; + $env{PERL_MB_OPT} = defined($new_top) ? "--install_base ${new_top}" : undef; + $env{PERL_MM_OPT} = defined($new_top) ? "INSTALL_BASE=${new_top}" : undef; } return %env; @@ -453,28 +501,36 @@ sub build_deact_all_environment_vars_for { my @active_lls = $class->active_paths; - my @new_perl5lib = split /\Q$Config{path_sep}/, $ENV{PERL5LIB}; - my @new_path = split /\Q$Config{path_sep}/, $ENV{PATH}; - - for my $path (@active_lls) { - @new_perl5lib = grep { - $_ ne $class->install_base_arch_path($path) && - $_ ne $class->install_base_perl_path($path) - } @new_perl5lib; - - @new_path = grep { - $_ ne $class->install_base_bin_path($path) - } @new_path; - } + my %perl_paths = map { ( + $class->install_base_perl_path($_) => 1, + $class->install_base_arch_path($_) => 1 + ) } @active_lls; + my %bin_paths = map { ( + $class->install_base_bin_path($_) => 1, + ) } @active_lls; my %env = ( PERL_LOCAL_LIB_ROOT => undef, PERL_MM_OPT => undef, PERL_MB_OPT => undef, - PERL5LIB => (@new_perl5lib ? - join($Config{path_sep}, @new_perl5lib) : undef + PERL5LIB => _env_list_value( + { + exists => 0, + filter => sub { + ! scalar grep { exists $perl_paths{$_} } $_[0] + }, + }, + \'PERL5LIB' + ), + PATH => _env_list_value( + { + exists => 0, + filter => sub { + ! scalar grep { exists $bin_paths{$_} } $_[0] + }, + }, + \'PATH' ), - PATH => join($Config{path_sep}, @new_path), ); return %env; @@ -645,7 +701,7 @@ C, you can use this: set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH% ### To set the environment for this shell alone - C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\temp.bat + C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\tmp.bat ### instead of $(perl -Mlocal::lib=./) If you want the environment entries to persist, you'll need to add then to the @@ -968,6 +1024,14 @@ On Win32 systems, C is also examined. =back +=head1 SEE ALSO + +=over 4 + +=item * L + +=back + =head1 SUPPORT IRC: @@ -1015,6 +1079,8 @@ G. de Oliveira . Improvements to stacking multiple local::lib dirs and removing them from the environment later on contributed by Andrew Rodland . +Patch for Carp version mismatch contributed by Hakim Cassimally . + =head1 COPYRIGHT Copyright (c) 2007 - 2010 the local::lib L and L as