bump version for release
[p5sagit/local-lib.git] / lib / local / lib.pm
index fe6f8c7..2e477e6 100644 (file)
@@ -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.008011'; # 1.8.11
 
 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<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<<
@@ -603,7 +701,7 @@ C<CMD.exe>, 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<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
@@ -731,6 +845,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
@@ -897,6 +1024,14 @@ On Win32 systems, C<COMSPEC> is also examined.
 
 =back
 
+=head1 SEE ALSO
+
+=over 4
+
+=item * L<Perl Advent article, 2011|http://perladvent.org/2011/2011-12-01.html>
+
+=back
+
 =head1 SUPPORT
 
 IRC:
@@ -941,6 +1076,11 @@ 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>.
+
+Patch for Carp version mismatch contributed by Hakim Cassimally <osfameron@cpan.org>.
+
 =head1 COPYRIGHT
 
 Copyright (c) 2007 - 2010 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as