Add a --deactivate option to remove a l::l from the env
[p5sagit/local-lib.git] / lib / local / lib.pm
index cbee5da..acf7e0b 100644 (file)
@@ -11,9 +11,9 @@ use File::Path ();
 use Carp ();
 use Config;
 
-our $VERSION = '1.006007'; # 1.6.7
+our $VERSION = '1.008001'; # 1.8.1
 
-our @KNOWN_FLAGS = qw(--self-contained);
+our @KNOWN_FLAGS = qw(--self-contained --deactivate);
 
 sub import {
   my ($class, @args) = @_;
@@ -52,7 +52,7 @@ DEATH
   }
 
   $arg_store{path} = $class->resolve_path($arg_store{path});
-  $class->setup_local_lib_for($arg_store{path});
+  $class->setup_local_lib_for($arg_store{path}, $arg_store{deactivate} || 0);
 
   for (@INC) { # Untaint @INC
     next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
@@ -188,22 +188,17 @@ is($c->resolve_relative_path('bar'),'FOObar');
 =cut
 
 sub setup_local_lib_for {
-  my ($class, $path) = @_;
-  $path = $class->ensure_dir_structure_for($path);
+  my ($class, $path, $deactivating) = @_;
+  $path = $class->ensure_dir_structure_for($path) unless $deactivating;
   if ($0 eq '-') {
-    $class->print_environment_vars_for($path);
+    $class->print_environment_vars_for($path, $deactivating);
     exit 0;
   } else {
-    $class->setup_env_hash_for($path);
+    $class->setup_env_hash_for($path, $deactivating);
     @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC);
   }
 }
 
-sub modulebuildrc_path {
-  my ($class, $path) = @_;
-  File::Spec->catfile($path, '.modulebuildrc');
-}
-
 sub install_base_bin_path {
   my ($class, $path) = @_;
   File::Spec->catdir($path, 'bin');
@@ -228,20 +223,6 @@ sub ensure_dir_structure_for {
   # 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';
-  my $modulebuildrc_path = $class->modulebuildrc_path($path);
-  if (-e $modulebuildrc_path) {
-    unless (-f _) {
-      Carp::croak("${modulebuildrc_path} exists but is not a plain file");
-    }
-  } else {
-    warn "Attempting to create file ${modulebuildrc_path}\n";
-    open MODULEBUILDRC, '>', $modulebuildrc_path
-      || Carp::croak("Couldn't open ${modulebuildrc_path} for writing: $!");
-    print MODULEBUILDRC qq{install  --install_base  ${path}\n}
-      || Carp::croak("Couldn't write line to ${modulebuildrc_path}: $!");
-    close MODULEBUILDRC
-      || Carp::croak("Couldn't close file ${modulebuildrc_path}: $@");
-  }
 
   return $path;
 }
@@ -249,16 +230,7 @@ sub ensure_dir_structure_for {
 sub INTERPOLATE_ENV () { 1 }
 sub LITERAL_ENV     () { 0 }
 
-sub print_environment_vars_for {
-  my ($class, $path) = @_;
-  my @envs = $class->build_environment_vars_for($path, LITERAL_ENV);
-  my $out = '';
-
-  # rather basic csh detection, goes on the assumption that something won't
-  # call itself csh unless it really is. also, default to bourne in the
-  # pathological situation where a user doesn't have $ENV{SHELL} defined.
-  # note also that shells with funny names, like zoid, are assumed to be
-  # bourne.
+sub guess_shelltype {
   my $shellbin = 'sh';
   if(defined $ENV{'SHELL'}) {
       my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
@@ -290,13 +262,33 @@ sub print_environment_vars_for {
                  }
          };
   }
+  return $shelltype;
+}
+
+sub print_environment_vars_for {
+  my ($class, $path, $deactivating) = @_;
+  print $class->environment_vars_string_for($path, $deactivating);
+}
+
+sub environment_vars_string_for {
+  my ($class, $path, $deactivating) = @_;
+  my @envs = $class->build_environment_vars_for($path, $deactivating, LITERAL_ENV);
+  my $out = '';
+
+  # rather basic csh detection, goes on the assumption that something won't
+  # call itself csh unless it really is. also, default to bourne in the
+  # pathological situation where a user doesn't have $ENV{SHELL} defined.
+  # note also that shells with funny names, like zoid, are assumed to be
+  # bourne.
+
+  my $shelltype = $class->guess_shelltype;
 
   while (@envs) {
     my ($name, $value) = (shift(@envs), shift(@envs));
-    $value =~ s/(\\")/\\$1/g;
+    $value =~ s/(\\")/\\$1/g if defined $value;
     $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
   }
-  print $out;
+  return $out;
 }
 
 # simple routines that take two arguments: an %ENV key and a value. return
@@ -305,31 +297,50 @@ sub print_environment_vars_for {
 sub build_bourne_env_declaration {
   my $class = shift;
   my($name, $value) = @_;
-  return qq{export ${name}="${value}"\n};
+  return defined($value) ? qq{export ${name}="${value}";\n} : qq{unset ${name};\n};
 }
 
 sub build_csh_env_declaration {
   my $class = shift;
   my($name, $value) = @_;
-  return qq{setenv ${name} "${value}"\n};
+  return defined($value) ? qq{setenv ${name} "${value}"\n} : qq{unsetenv ${name}\n};
 }
 
 sub build_win32_env_declaration {
   my $class = shift;
   my($name, $value) = @_;
-  return qq{set ${name}=${value}\n};
+  return defined($value) ? qq{set ${name}=${value}\n} : qq{set ${name}=\n};
 }
 
 sub setup_env_hash_for {
-  my ($class, $path) = @_;
-  my %envs = $class->build_environment_vars_for($path, INTERPOLATE_ENV);
+  my ($class, $path, $deactivating) = @_;
+  my %envs = $class->build_environment_vars_for($path, $deactivating, INTERPOLATE_ENV);
   @ENV{keys %envs} = values %envs;
 }
 
 sub build_environment_vars_for {
+  my ($class, $path, $deactivating, $interpolate) = @_;
+
+  if ($deactivating) {
+    return $class->build_deactivate_environment_vars_for($path, $interpolate);
+  } else {
+    return $class->build_activate_environment_vars_for($path, $interpolate);
+  }
+}
+
+sub build_activate_environment_vars_for {
   my ($class, $path, $interpolate) = @_;
   return (
-    MODULEBUILDRC => $class->modulebuildrc_path($path),
+    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_MB_OPT => "--install_base ${path}",
     PERL_MM_OPT => "INSTALL_BASE=${path}",
     PERL5LIB => join($Config{path_sep},
                   $class->install_base_arch_path($path),
@@ -349,6 +360,55 @@ sub build_environment_vars_for {
   )
 }
 
+sub build_deactivate_environment_vars_for {
+  my ($class, $path, $interpolate) = @_;
+
+  my @active_lls = split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT} || '';
+
+  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 %env = (
+    PERL_LOCAL_LIB_ROOT => (@new_ll_root ?
+      join($Config{path_sep}, @new_ll_root) : undef
+    ),
+    PERL5LIB => (@new_perl5lib ?
+      join($Config{path_sep}, @new_perl5lib) : undef
+    ),
+    PATH => join($Config{path_sep},
+      grep { $_ ne $class->install_base_bin_path($path) }
+      split /\Q$Config{path_sep}/, $ENV{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,
+      );
+    }
+  }
+
+  return %env;
+}
+
 =begin testing
 
 #:: test classmethod
@@ -359,8 +419,6 @@ $c->ensure_dir_structure_for('t/var/splat');
 
 ok(-d 't/var/splat');
 
-ok(-f 't/var/splat/.modulebuildrc');
-
 =end testing
 
 =encoding utf8
@@ -388,10 +446,10 @@ From the shell -
 
   # Just print out useful shell commands
   $ perl -Mlocal::lib
-  export MODULEBUILDRC=/home/username/perl/.modulebuildrc
-  export PERL_MM_OPT='INSTALL_BASE=/home/username/perl'
-  export PERL5LIB='/home/username/perl/lib/perl5:/home/username/perl/lib/perl5/i386-linux'
-  export PATH="/home/username/perl/bin:$PATH"
+  export PERL_MB_OPT='--install_base /home/username/perl5'
+  export PERL_MM_OPT='INSTALL_BASE=/home/username/perl5'
+  export PERL5LIB='/home/username/perl5/lib/perl5/i386-linux:/home/username/perl5/lib/perl5'
+  export PATH="/home/username/perl5/bin:$PATH"
 
 =head2 The bootstrapping technique
 
@@ -494,7 +552,7 @@ To set up the proper environment variables for your current session of
 C<CMD.exe>, you can use this:
 
   C:\>perl -Mlocal::lib
-  set MODULEBUILDRC=C:\DOCUME~1\ADMINI~1\perl5\.modulebuildrc
+  set PERL_MB_OPT=--install_base C:\DOCUME~1\ADMINI~1\perl5
   set PERL_MM_OPT=INSTALL_BASE=C:\DOCUME~1\ADMINI~1\perl5
   set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5;C:\DOCUME~1\ADMINI~1\perl5\lib\perl5\MSWin32-x86-multi-thread
   set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH%
@@ -554,7 +612,7 @@ values:
 
 =over 4
 
-=item MODULEBUILDRC
+=item PERL_MB_OPT
 
 =item PERL_MM_OPT
 
@@ -671,19 +729,6 @@ Returns a path describing where to install the executable programs for this
 local library installation. Based on the L</install_base_perl_path> method's
 return value, and appends the directory C<bin>.
 
-=head2 modulebuildrc_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $modulebuildrc_path
-
-=back
-
-Returns a path describing where to install the C<.modulebuildrc> file, based on
-the given path.
-
 =head2 resolve_empty_path
 
 =over 4
@@ -767,7 +812,7 @@ not set, a Bourne-compatible shell is assumed.
 Bootstrap is a hack and will use CPAN.pm for ExtUtils::MakeMaker even if you
 have CPANPLUS installed.
 
-Kills any existing PERL5LIB, PERL_MM_OPT or MODULEBUILDRC.
+Kills any existing PERL5LIB, PERL_MM_OPT or PERL_MB_OPT.
 
 Should probably auto-fixup CPAN config if not already done.