Add method docs for active_paths
[p5sagit/local-lib.git] / lib / local / lib.pm
index acf7e0b..8f9b8d7 100644 (file)
@@ -13,7 +13,13 @@ use Config;
 
 our $VERSION = '1.008001'; # 1.8.1
 
-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 +57,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.
@@ -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;
+
+  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;
+    }
+  }
+
+  $path = $class->ensure_dir_structure_for($path);
+
   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,8 +351,10 @@ 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);
   }
@@ -360,10 +392,17 @@ sub build_activate_environment_vars_for {
   )
 }
 
+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";
@@ -409,6 +448,38 @@ sub build_deactivate_environment_vars_for {
   return %env;
 }
 
+sub build_deact_all_environment_vars_for {
+  my ($class, $path, $interpolate) = @_;
+
+  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 %env = (
+    PERL_LOCAL_LIB_ROOT => undef,
+    PERL_MM_OPT => undef,
+    PERL_MB_OPT => undef,
+    PERL5LIB => (@new_perl5lib ?
+      join($Config{path_sep}, @new_perl5lib) : undef
+    ),
+    PATH => join($Config{path_sep}, @new_path),
+  );
+
+  return %env;
+}
+
 =begin testing
 
 #:: test classmethod
@@ -530,6 +601,22 @@ installation to install modules in different directories directly this way:
   cd ../mydir2
   ... REPEAT ...
 
+If you are working with several C<local::lib> 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<activated most recently> 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<local::lib> 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<<
@@ -632,6 +719,22 @@ See L<lib::core::only> 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<local::lib> import besides the
+directory to use. They are specified as C<use local::lib '--option'[, path];>
+or C<perl -Mlocal::lib=--option[,path]>.
+
+=head2 --deactivate
+
+Remove the chosen path (or the default path) from the module search paths if it
+was added by C<local::lib>, instead of adding it.
+
+=head2 --deactivate-all
+
+Remove all directories that were added to search paths by C<local::lib> from the
+search paths.
+
 =head1 METHODS
 
 =head2 ensure_dir_structure_for
@@ -686,6 +789,19 @@ given path as the base directory.
 Constructs the C<%ENV> keys for the given path, by calling
 L</build_environment_vars_for>.
 
+=head2 active_paths
+
+=over 4
+
+=item Arguments: None
+
+=item Return value: @paths
+
+=back
+
+Returns a list of active C<local::lib> paths, according to the
+C<PERL_LOCAL_LIB_ROOT> environment variable.
+
 =head2 install_base_perl_path
 
 =over 4
@@ -896,6 +1012,9 @@ David Mertens <dcmertens.perl@gmail.com> (run4flat).
 Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc patches contributed by Breno
 G. de Oliveira <garu@cpan.org>.
 
+Improvements to stacking multiple local::lib dirs and removing them from the
+environment later on contributed by Andrew Rodland <arodland@cpan.org>.
+
 =head1 COPYRIGHT
 
 Copyright (c) 2007 - 2010 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as