X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Flocal%2Flib.pm;h=d663bb4eb8c8776a58436229d54e0c97ad0f43d3;hb=163f162c011a79860caafe94403857ad08200825;hp=fe6f8c7b467d212ababaf6542209a11ab11112d7;hpb=15f79556fbef7bb74a27f049a07dce0d761f14d6;p=p5sagit%2Flocal-lib.git diff --git a/lib/local/lib.pm b/lib/local/lib.pm index fe6f8c7..d663bb4 100644 --- a/lib/local/lib.pm +++ b/lib/local/lib.pm @@ -8,16 +8,18 @@ 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.008001'; # 1.8.1 +our $VERSION = '1.008010'; # 1.8.10 our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all); sub DEACTIVATE_ONE () { 1 } sub DEACTIVATE_ALL () { 2 } +sub INTERPOLATE_ENV () { 1 } +sub LITERAL_ENV () { 0 } + sub import { my ($class, @args) = @_; @@ -172,6 +174,7 @@ sub resolve_home_path { } }; unless (defined $homedir) { + require Carp; Carp::croak( "Couldn't resolve homedir for " .(defined $user ? $user : 'current user') @@ -200,13 +203,46 @@ is($c->resolve_relative_path('bar'),'FOObar'); sub setup_local_lib_for { my ($class, $path, $deactivating) = @_; - $path = $class->ensure_dir_structure_for($path) unless $deactivating; + + my $interpolate = LITERAL_ENV; + my @active_lls = $class->active_paths; + + $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) { + exit 0 if $0 eq '-'; + return; # Asked to add what's already at the top of the stack + } elsif (grep { $_ eq $path} @active_lls) { + # Asked to add a dir that's lower in the stack -- so we remove it from + # where it is, and then add it back at the top. + $class->setup_env_hash_for($path, DEACTIVATE_ONE); + # Which means we can no longer output "PERL5LIB=...:$PERL5LIB" stuff + # anymore because we're taking something *out*. + $interpolate = INTERPOLATE_ENV; + } + } + if ($0 eq '-') { - $class->print_environment_vars_for($path, $deactivating); + $class->print_environment_vars_for($path, $deactivating, $interpolate); 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 + ); } } @@ -231,16 +267,9 @@ 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 INTERPOLATE_ENV () { 1 } -sub LITERAL_ENV () { 0 } - sub guess_shelltype { my $shellbin = 'sh'; if(defined $ENV{'SHELL'}) { @@ -277,13 +306,13 @@ sub guess_shelltype { } sub print_environment_vars_for { - my ($class, $path, $deactivating) = @_; - print $class->environment_vars_string_for($path, $deactivating); + my ($class, $path, $deactivating, $interpolate) = @_; + print $class->environment_vars_string_for($path, $deactivating, $interpolate); } sub environment_vars_string_for { - my ($class, $path, $deactivating) = @_; - my @envs = $class->build_environment_vars_for($path, $deactivating, LITERAL_ENV); + my ($class, $path, $deactivating, $interpolate) = @_; + my @envs = $class->build_environment_vars_for($path, $deactivating, $interpolate); my $out = ''; # rather basic csh detection, goes on the assumption that something won't @@ -341,82 +370,127 @@ 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', + ), ) } +sub active_paths { + my ($class) = @_; + + return () unless defined $ENV{PERL_LOCAL_LIB_ROOT}; + return grep { $_ ne '' } split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT}; +} + sub build_deactivate_environment_vars_for { my ($class, $path, $interpolate) = @_; - my @active_lls = split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT} || ''; + my @active_lls = $class->active_paths; if (!grep { $_ eq $path } @active_lls) { warn "Tried to deactivate inactive local::lib '$path'\n"; 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; @@ -425,30 +499,38 @@ sub build_deactivate_environment_vars_for { sub build_deact_all_environment_vars_for { my ($class, $path, $interpolate) = @_; - my @active_lls = split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT} || ''; - - my @new_perl5lib = split /\Q$Config{path_sep}/, $ENV{PERL5LIB}; - my @new_path = split /\Q$Config{path_sep}/, $ENV{PATH}; + my @active_lls = $class->active_paths; - 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; @@ -575,6 +657,22 @@ installation to install modules in different directories directly this way: cd ../mydir2 ... REPEAT ... +If you are working with several C environments, you may want to +remove some of them from the current environment without disturbing the others. +You can deactivate one environment like this (using bourne sh): + + eval $(perl -Mlocal::lib=--deactivate,~/path) + +which will generate and run the commands needed to remove C<~/path> from your +various search paths. Whichever environment was B will +remain the target for module installations. That is, if you activate +C<~/path_A> and then you activate C<~/path_B>, new modules you install will go +in C<~/path_B>. If you deactivate C<~/path_B> then modules will be installed +into C<~/pathA> -- but if you deactivate C<~/path_A> then they will still be +installed in C<~/pathB> because pathB was activated later. + +You can also ask C to clean itself completely out of the current +shell's environment with the C<--deactivate-all> option. For multiple environments for multiple apps you may need to include a modified version of the C<< use FindBin >> instructions in the "In code" sample above. If you did something like the above, you have a set of Perl modules at C<< @@ -603,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 @@ -677,6 +775,22 @@ See L for one way to do this - but note that there are a number of caveats, and the best approach is always to perform a build against a clean perl (i.e. site and vendor as close to empty as possible). +=head1 OPTIONS + +Options are values that can be passed to the C import besides the +directory to use. They are specified as C +or C. + +=head2 --deactivate + +Remove the chosen path (or the default path) from the module search paths if it +was added by C, instead of adding it. + +=head2 --deactivate-all + +Remove all directories that were added to search paths by C from the +search paths. + =head1 METHODS =head2 ensure_dir_structure_for @@ -731,6 +845,19 @@ given path as the base directory. Constructs the C<%ENV> keys for the given path, by calling L. +=head2 active_paths + +=over 4 + +=item Arguments: None + +=item Return value: @paths + +=back + +Returns a list of active C paths, according to the +C environment variable. + =head2 install_base_perl_path =over 4 @@ -897,6 +1024,14 @@ On Win32 systems, C is also examined. =back +=head1 SEE ALSO + +=over 4 + +=item * L + +=back + =head1 SUPPORT IRC: @@ -941,6 +1076,11 @@ David Mertens (run4flat). Brazilian L and minor doc patches contributed by Breno 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