X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Flocal%2Flib.pm;h=8533b1c7fbcc1a2b7b00519bb43b080cb46d5210;hb=bfa78fcf26aa9eea1aad118b5f8d25a44db7f2ac;hp=acf7e0bbb62190d49adbbff3ac71790517f6ec4d;hpb=4c7189136265a95f389569291306369ef3bb303a;p=p5sagit%2Flocal-lib.git diff --git a/lib/local/lib.pm b/lib/local/lib.pm index acf7e0b..8533b1c 100644 --- a/lib/local/lib.pm +++ b/lib/local/lib.pm @@ -8,12 +8,17 @@ 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.008006'; # 1.8.6 -our @KNOWN_FLAGS = qw(--self-contained --deactivate); +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) = @_; @@ -51,8 +56,16 @@ DEATH die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise).\n"; } + my $deactivating = 0; + if ($arg_store{deactivate}) { + $deactivating = DEACTIVATE_ONE; + } + if ($arg_store{'deactivate-all'}) { + $deactivating = DEACTIVATE_ALL; + } + $arg_store{path} = $class->resolve_path($arg_store{path}); - $class->setup_local_lib_for($arg_store{path}, $arg_store{deactivate} || 0); + $class->setup_local_lib_for($arg_store{path}, $deactivating); for (@INC) { # Untaint @INC next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc. @@ -161,6 +174,7 @@ sub resolve_home_path { } }; unless (defined $homedir) { + require Carp; Carp::croak( "Couldn't resolve homedir for " .(defined $user ? $user : 'current user') @@ -189,9 +203,28 @@ 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; + + $path = $class->ensure_dir_structure_for($path); + + 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); @@ -227,9 +260,6 @@ sub ensure_dir_structure_for { return $path; } -sub INTERPOLATE_ENV () { 1 } -sub LITERAL_ENV () { 0 } - sub guess_shelltype { my $shellbin = 'sh'; if(defined $ENV{'SHELL'}) { @@ -266,13 +296,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 @@ -321,94 +351,181 @@ sub setup_env_hash_for { sub build_environment_vars_for { my ($class, $path, $deactivating, $interpolate) = @_; - if ($deactivating) { + if ($deactivating == DEACTIVATE_ONE) { return $class->build_deactivate_environment_vars_for($path, $interpolate); + } elsif ($deactivating == DEACTIVATE_ALL) { + return $class->build_deact_all_environment_vars_for($path, $interpolate); } else { return $class->build_activate_environment_vars_for($path, $interpolate); } } +# 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) { + exists $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_arch_path($path), + $class->install_base_perl_path($path), + \'PERL5LIB', + ), + PATH => _env_list_value( + { interpolate => $interpolate, exists => 0, empty => '' }, + \'PATH', + ), ) } +sub active_paths { + my ($class) = @_; + + return () unless defined $ENV{PERL_LOCAL_LIB_ROOT}; + return 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; } +sub build_deact_all_environment_vars_for { + my ($class, $path, $interpolate) = @_; + + my @active_lls = $class->active_paths; + + 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 => _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' + ), + ); + + return %env; +} + =begin testing #:: test classmethod @@ -530,6 +647,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<< @@ -558,7 +691,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 @@ -632,6 +765,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 @@ -686,6 +835,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 @@ -896,6 +1058,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