move win32 path shortening back to correct location
[p5sagit/local-lib.git] / lib / local / lib.pm
index 8712b9c..f5e4778 100644 (file)
@@ -3,31 +3,25 @@ use warnings;
 
 package local::lib;
 
-use 5.008001; # probably works with earlier versions but I'm not supporting them
-              # (patches would, of course, be welcome)
+use 5.006;
 
 use File::Spec ();
-use File::Path ();
-use Carp ();
 use Config;
 
-our $VERSION = '1.008001'; # 1.8.1
-
-our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all);
-
-sub DEACTIVATE_ONE () { 1 }
-sub DEACTIVATE_ALL () { 2 }
+our $VERSION = '1.008026'; # 1.8.26
+$VERSION = eval $VERSION;
 
 sub import {
   my ($class, @args) = @_;
 
-  # Remember what PERL5LIB was when we started
-  my $perl5lib = $ENV{PERL5LIB} || '';
+  my @steps;
+  my %opts;
 
-  my %arg_store;
-  for my $arg (@args) {
+  while (@args) {
+    my $arg = shift @args;
     # check for lethal dash first to stop processing before causing problems
-    if ($arg =~ /−/) {
+    # the fancy dash is U+2212 or \xE2\x88\x92
+    if ($arg =~ /\xE2\x88\x92/ or $arg =~ /−/) {
       die <<'DEATH';
 WHOA THERE! It looks like you've got some fancy dashes in your commandline!
 These are *not* the traditional -- dashes that software recognizes. You
@@ -37,38 +31,350 @@ terminal, but can happen elsewhere too. Please try again after replacing the
 dashes with normal minus signs.
 DEATH
     }
-    elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
-      (my $flag = $arg) =~ s/--//;
-      $arg_store{$flag} = 1;
+    elsif ($arg eq '--self-contained') {
+      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";
+    }
+    elsif( $arg =~ /^--deactivate(?:=(.*))?$/ ) {
+      my $path = defined $1 ? $1 : shift @args;
+      push @steps, ['deactivate', $path];
+    }
+    elsif ( $arg eq '--deactivate-all' ) {
+      push @steps, ['deactivate_all'];
     }
-    elsif($arg =~ /^--/) {
+    elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) {
+      my $shell = defined $1 ? $1 : shift @args;
+      $opts{shelltype} = $shell;
+    }
+    elsif ( $arg eq '--no-create' ) {
+      $opts{no_create} = 1;
+    }
+    elsif ( $arg =~ /^--/ ) {
       die "Unknown import argument: $arg";
     }
     else {
-      # assume that what's left is a path
-      $arg_store{path} = $arg;
+      push @steps, ['activate', $arg];
     }
   }
+  if (!@steps) {
+    push @steps, ['activate', undef];
+  }
+
+  my $self = $class->new(%opts);
 
-  if($arg_store{'self-contained'}) {
-    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";
+  for (@steps) {
+    my ($method, @args) = @$_;
+    $self = $self->$method(@args);
   }
 
-  my $deactivating = 0;
-  if ($arg_store{deactivate}) {
-    $deactivating = DEACTIVATE_ONE;
+  if ($0 eq '-') {
+    $self->print_environment_vars_for;
+    exit 0;
   }
-  if ($arg_store{'deactivate-all'}) {
-    $deactivating = DEACTIVATE_ALL;
+  else {
+    $self->setup_local_lib_for;
+  }
+}
+
+sub new {
+  my $class = shift;
+  bless {@_}, $class;
+}
+
+sub clone {
+  my $self = shift;
+  bless {%$self, @_}, ref $self;
+}
+
+sub inc { $_[0]->{inc}     ||= \@INC }
+sub libs { $_[0]->{libs}   ||= [ \'PERL5LIB' ] }
+sub bins { $_[0]->{bins}   ||= [ \'PATH' ] }
+sub roots { $_[0]->{roots} ||= [ \'PERL_LOCAL_LIB_ROOT' ] }
+sub extra { $_[0]->{extra} ||= {} }
+sub shelltype { $_[0]->{shelltype} ||= $_[0]->guess_shelltype }
+sub no_create { $_[0]->{no_create} }
+
+my $_archname = $Config{archname};
+my $_version  = $Config{version};
+my @_inc_version_list = reverse split / /, $Config{inc_version_list};
+my $_path_sep = $Config{path_sep};
+
+sub _as_list {
+  my $list = shift;
+  grep length, map {
+    !(ref $_ && ref $_ eq 'SCALAR') ? $_ : (
+      defined $ENV{$$_} ? split(/\Q$_path_sep/, $ENV{$$_})
+                        : ()
+    )
+  } ref $list ? @$list : $list;
+}
+sub _remove_from {
+  my ($list, @remove) = @_;
+  my %remove = map { $_ => 1 } @remove;
+  grep !$remove{$_}, _as_list($list);
+}
+
+my @_lib_subdirs = (
+  [$_version, $_archname],
+  [$_version],
+  [$_archname],
+  (@_inc_version_list ? \@_inc_version_list : ()),
+  [],
+);
+
+sub install_base_bin_path {
+  my ($class, $path) = @_;
+  return File::Spec->catdir($path, 'bin');
+}
+sub install_base_perl_path {
+  my ($class, $path) = @_;
+  return File::Spec->catdir($path, 'lib', 'perl5');
+}
+sub install_base_arch_path {
+  my ($class, $path) = @_;
+  File::Spec->catdir($class->install_base_perl_path($path), $_archname);
+}
+
+sub lib_paths_for {
+  my ($class, $path) = @_;
+  my $base = $class->install_base_perl_path($path);
+  return map { File::Spec->catdir($base, @$_) } @_lib_subdirs;
+}
+
+sub _mm_escape_path {
+  my $path = shift;
+  $path =~ s/\\/\\\\\\\\/g;
+  if ($path =~ s/ /\\ /g) {
+    $path = qq{"\\"$path\\""};
   }
+  return $path;
+}
+
+sub _mb_escape_path {
+  my $path = shift;
+  $path =~ s/\\/\\\\/g;
+  return qq{"$path"};
+}
+
+sub installer_options_for {
+  my ($class, $path) = @_;
+  return {
+    PERL_MM_OPT => defined $path ? "INSTALL_BASE="._mm_escape_path($path) : undef,
+    PERL_MB_OPT => defined $path ? "--install_base "._mb_escape_path($path) : undef,
+  };
+}
+
+sub active_paths {
+  my ($self) = @_;
+  $self = ref $self ? $self : $self->new;
+
+  return grep {
+    # screen out entries that aren't actually reflected in @INC
+    my $active_ll = $self->install_base_perl_path($_);
+    grep { $_ eq $active_ll } @{$self->inc};
+  } _as_list($self->roots);
+}
+
+
+sub deactivate {
+  my ($self, $path) = @_;
+  $self = $self->new unless ref $self;
+  $path = $self->resolve_path($path);
 
-  $arg_store{path} = $class->resolve_path($arg_store{path});
-  $class->setup_local_lib_for($arg_store{path}, $deactivating);
+  my @active_lls = $self->active_paths;
 
-  for (@INC) { # Untaint @INC
-    next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
-    m/(.*)/ and $_ = $1;
+  if (!grep { $_ eq $path } @active_lls) {
+    warn "Tried to deactivate inactive local::lib '$path'\n";
+    return $self;
   }
+
+  my %args = (
+    bins  => [ _remove_from($self->bins,  $self->install_base_bin_path($path)) ],
+    libs  => [ _remove_from($self->libs,  $self->install_base_perl_path($path)) ],
+    inc   => [ _remove_from($self->inc,   $self->lib_paths_for($path)) ],
+    roots => [ _remove_from($self->roots, $path) ],
+  );
+
+  $args{extra} = $self->installer_options_for($args{roots}[0]);
+
+  $self->clone(%args);
+}
+
+sub deactivate_all {
+  my ($self) = @_;
+  $self = $self->new unless ref $self;
+
+  my @active_lls = $self->active_paths;
+
+  my %args = (
+    bins => [ _remove_from($self->bins,
+      map $self->install_base_bin_path($_), @active_lls) ],
+    libs => [ _remove_from($self->libs,
+      map $self->install_base_perl_path($_), @active_lls) ],
+    inc => [ _remove_from($self->inc,
+      map $self->lib_paths_for($_), @active_lls) ],
+    roots => [ _remove_from($self->roots, @active_lls) ],
+  );
+
+  $args{extra} = $self->installer_options_for(undef);
+
+  $self->clone(%args);
+}
+
+sub activate {
+  my ($self, $path) = @_;
+  $self = $self->new unless ref $self;
+  $path = $self->resolve_path($path);
+  $self->ensure_dir_structure_for($path)
+    unless $self->no_create;
+
+  $path = ( Win32::GetShortPathName($path) || $path )
+    if $^O eq 'MSWin32';
+
+  my @active_lls = $self->active_paths;
+
+  if (grep { $_ eq $path } @active_lls) {
+    $self = $self->deactivate($path);
+  }
+
+  my %args = (
+    bins  => [ $self->install_base_bin_path($path), @{$self->bins} ],
+    libs  => [ $self->install_base_perl_path($path), @{$self->libs} ],
+    inc   => [ $self->lib_paths_for($path), @{$self->inc} ],
+    roots => [ $path, @{$self->roots} ],
+  );
+
+  $args{extra} = $self->installer_options_for($path);
+
+  $self->clone(%args);
+}
+
+sub _legacy {
+  my ($self, $path) = @_;
+  $self = $self->new unless ref $self;
+  if (defined $path) {
+    $self = $self->activate($path);
+  }
+  $self;
+}
+
+sub build_environment_vars_for {
+  my ($self) = _legacy(@_);
+  (
+    PATH                => join($_path_sep, _as_list($self->bins)),
+    PERL5LIB            => join($_path_sep, _as_list($self->libs)),
+    PERL_LOCAL_LIB_ROOT => join($_path_sep, _as_list($self->roots)),
+    %{$self->extra},
+  );
+}
+
+sub setup_local_lib_for {
+  my ($self) = _legacy(@_);
+  $self->setup_env_hash_for;
+  @INC = @{$self->inc};
+}
+
+sub setup_env_hash_for {
+  my $self = shift;
+  my %env = $self->build_environment_vars_for(@_);
+  for my $key (keys %env) {
+    if (defined $env{$key}) {
+      $ENV{$key} = $env{$key};
+    }
+    else {
+      delete $ENV{$key};
+    }
+  }
+}
+
+sub print_environment_vars_for {
+  my $self = shift;
+  print $self->environment_vars_string_for(@_);
+}
+
+sub environment_vars_string_for {
+  my $self = _legacy(@_);
+
+  my $build_method = 'build_' . $self->shelltype . '_env_declaration';
+
+  my @envs = (
+    PATH                => $self->bins,
+    PERL5LIB            => $self->libs,
+    PERL_LOCAL_LIB_ROOT => $self->roots,
+    %{$self->extra},
+  );
+  my $out = '';
+  while (@envs) {
+    my ($name, $value) = (shift(@envs), shift(@envs));
+    if (
+        ref $value
+        && @$value == 1
+        && ref $value->[0]
+        && ref $value->[0] eq 'SCALAR'
+        && ${$value->[0]} eq $name) {
+      next;
+    }
+    if (!ref $value
+        && $value eq $ENV{$name}) {
+      next;
+    }
+    $out .= $self->$build_method($name, $value);
+  }
+  return $out;
+}
+
+sub build_bourne_env_declaration {
+  my ($class, $name, $args) = @_;
+  my $value = $class->_interpolate($args);
+  $value =~ s/"/\\"/g
+    if defined $value;
+  return defined($value) ? qq{export ${name}="${value}"\n} : qq{unset ${name}\n};
+}
+sub build_csh_env_declaration {
+  my ($class, $name, $args) = @_;
+  my ($value, @vars) = $class->_interpolate($args);
+  @vars = grep { $_ ne $name || defined $value } @vars;
+  $value =~ s/"/"\\""/g
+    if defined $value;
+  join '',
+    (map qq{if ! \$?$_ setenv $_ "";\n}, @vars),
+    (defined($value)
+      ? qq{setenv $name "$value";\n}
+      : qq{unsetenv $name;\n});
+}
+sub build_cmd_env_declaration {
+  my ($class, $name, $args) = @_;
+  my $value = $class->_interpolate($args, '%', '%');
+  $value =~ s/"/\\"/g
+    if defined $value;
+  return qq{set $name=} . (defined($value) ? qq{"$value"} : '') . "\n";
+}
+sub build_powershell_env_declaration {
+  my ($class, $name, $args) = @_;
+  my $value = $class->_interpolate($args, '$env:');
+  if (defined $value) {
+    $value =~ s/"/\\"/g;
+    return qq{\$env:$name = "$value"\n};
+  }
+  return "Remove-Item Env:\\$name\n";
+}
+
+
+sub _interpolate {
+  my ($class, $args, $start, $end) = @_;
+  return
+    unless defined $args;
+  return $args
+    unless ref $args;
+  return
+    unless @$args;
+  $start = '$' unless defined $start;
+  $end = '' unless defined $end;
+  my @vars;
+  my $string = join($Config{path_sep}, map {
+    (ref $_ && ref $_ eq 'SCALAR') ? do { push @vars, $$_; $start.$$_.$end }
+      : $_
+  } @$args);
+  return wantarray ? ($string, @vars) : $string;
 }
 
 sub pipeline;
@@ -97,25 +403,23 @@ sub pipeline {
 package local::lib;
 
 { package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
-my $foo = bless({}, 'Foo');                                                 
+my $foo = bless({}, 'Foo');
 Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
 
 =end testing
 
 =cut
 
-sub _uniq {
-    my %seen;
-    grep { ! $seen{$_}++ } @_;
-}
-
 sub resolve_path {
   my ($class, $path) = @_;
-  $class->${pipeline qw(
+
+  $path = $class->${pipeline qw(
     resolve_relative_path
     resolve_home_path
     resolve_empty_path
   )}($path);
+
+  $path;
 }
 
 sub resolve_empty_path {
@@ -150,32 +454,20 @@ sub resolve_home_path {
   my ($class, $path) = @_;
   return $path unless ($path =~ /^~/);
   my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
-  my $tried_file_homedir;
   my $homedir = do {
-    if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
-      $tried_file_homedir = 1;
-      if (defined $user) {
-        File::HomeDir->users_home($user);
-      } else {
-        File::HomeDir->my_home;
-      }
-    } else {
-      if (defined $user) {
-        (getpwnam $user)[7];
-      } else {
-        if (defined $ENV{HOME}) {
-          $ENV{HOME};
-        } else {
-          (getpwuid $<)[7];
-        }
-      }
+    if (!defined $user && defined $ENV{HOME}) {
+      $ENV{HOME}
+    }
+    else {
+      require File::Glob;
+      File::Glob::bsd_glob("~$user", File::Glob::GLOB_TILDE());
     }
   };
   unless (defined $homedir) {
+    require Carp;
     Carp::croak(
       "Couldn't resolve homedir for "
       .(defined $user ? $user : 'current user')
-      .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
     );
   }
   $path =~ s/^~[^\/]*/$homedir/;
@@ -198,260 +490,19 @@ is($c->resolve_relative_path('bar'),'FOObar');
 
 =cut
 
-sub setup_local_lib_for {
-  my ($class, $path, $deactivating) = @_;
-  $path = $class->ensure_dir_structure_for($path) unless $deactivating;
-  if ($0 eq '-') {
-    $class->print_environment_vars_for($path, $deactivating);
-    exit 0;
-  } else {
-    $class->setup_env_hash_for($path, $deactivating);
-    @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC);
-  }
-}
-
-sub install_base_bin_path {
-  my ($class, $path) = @_;
-  File::Spec->catdir($path, 'bin');
-}
-
-sub install_base_perl_path {
-  my ($class, $path) = @_;
-  File::Spec->catdir($path, 'lib', 'perl5');
-}
-
-sub install_base_arch_path {
-  my ($class, $path) = @_;
-  File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
-}
-
 sub ensure_dir_structure_for {
   my ($class, $path) = @_;
   unless (-d $path) {
     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;
-}
-
-sub INTERPOLATE_ENV () { 1 }
-sub LITERAL_ENV     () { 0 }
-
-sub guess_shelltype {
-  my $shellbin = 'sh';
-  if(defined $ENV{'SHELL'}) {
-      my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
-      $shellbin = $shell_bin_path_parts[-1];
-  }
-  my $shelltype = do {
-      local $_ = $shellbin;
-      if(/csh/) {
-          'csh'
-      } else {
-          'bourne'
-      }
-  };
-
-  # Both Win32 and Cygwin have $ENV{COMSPEC} set.
-  if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
-      my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
-      $shellbin = $shell_bin_path_parts[-1];
-         $shelltype = do {
-                 local $_ = $shellbin;
-                 if(/command\.com/) {
-                         'win32'
-                 } elsif(/cmd\.exe/) {
-                         'win32'
-                 } elsif(/4nt\.exe/) {
-                         'win32'
-                 } else {
-                         $shelltype
-                 }
-         };
-  }
-  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 if defined $value;
-    $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
-  }
-  return $out;
-}
-
-# simple routines that take two arguments: an %ENV key and a value. return
-# strings that are suitable for passing directly to the relevant shell to set
-# said key to said value.
-sub build_bourne_env_declaration {
-  my $class = shift;
-  my($name, $value) = @_;
-  return defined($value) ? qq{export ${name}="${value}";\n} : qq{unset ${name};\n};
-}
-
-sub build_csh_env_declaration {
-  my $class = shift;
-  my($name, $value) = @_;
-  return defined($value) ? qq{setenv ${name} "${value}"\n} : qq{unsetenv ${name}\n};
-}
-
-sub build_win32_env_declaration {
-  my $class = shift;
-  my($name, $value) = @_;
-  return defined($value) ? qq{set ${name}=${value}\n} : qq{set ${name}=\n};
-}
-
-sub setup_env_hash_for {
-  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 == 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);
-  }
-}
-
-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_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%' ))
-             ),
-  )
-}
-
-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;
-}
-
-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};
-
-  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;
+  require File::Basename;
+  my @dirs;
+  while(!-d $path) {
+    push @dirs, $path;
+    $path = File::Basename::dirname($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;
+  mkdir $_ for reverse @dirs;
+  return;
 }
 
 =begin testing
@@ -466,6 +517,34 @@ ok(-d 't/var/splat');
 
 =end testing
 
+=cut
+
+sub guess_shelltype {
+  my $shellbin
+    = defined $ENV{SHELL}
+      ? (File::Spec->splitpath($ENV{SHELL}))[-1]
+    : ( $^O eq 'MSWin32' && exists $ENV{'!EXITCODE'} )
+      ? 'bash'
+    : ( $^O eq 'MSWin32' && $ENV{PROMPT} && $ENV{COMSPEC} )
+      ? (File::Spec->splitpath($ENV{COMSPEC}))[-1]
+    : ( $^O eq 'MSWin32' && !$ENV{PROMPT} )
+      ? 'powershell.exe'
+    : 'sh';
+
+  for ($shellbin) {
+    return
+        /csh/             ? 'csh'
+      : /command\.com/    ? 'cmd'
+      : /cmd\.exe/        ? 'cmd'
+      : /4nt\.exe/        ? 'cmd'
+      : /powershell\.exe/ ? 'powershell'
+                          : 'bourne';
+  }
+}
+
+1;
+__END__
+
 =encoding utf8
 
 =head1 NAME
@@ -493,7 +572,7 @@ From the shell -
   $ perl -Mlocal::lib
   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 PERL5LIB="/home/username/perl5/lib/perl5"
   export PATH="/home/username/perl5/bin:$PATH"
 
 =head2 The bootstrapping technique
@@ -501,9 +580,9 @@ From the shell -
 A typical way to install local::lib is using what is known as the
 "bootstrapping" technique.  You would do this if your system administrator
 hasn't already installed local::lib.  In this case, you'll need to install
-local::lib in your home directory. 
+local::lib in your home directory.
 
-If you do have administrative privileges, you will still want to set up your 
+Even if you do have administrative privileges, you will still want to set up your
 environment variables, as discussed in step 4. Without this, you would still
 install the modules into the system CPAN installation and also your Perl scripts
 will not use the lib/ path you bootstrapped with local::lib.
@@ -533,7 +612,7 @@ to specify the name of the directory when you call bootstrap, as follows:
 
   make test && make install
 
-4. Now we need to setup the appropriate environment variables, so that Perl 
+4. Now we need to setup the appropriate environment variables, so that Perl
 starts using our newly generated lib/ directory. If you are using bash or
 any other Bourne shells, you can add this to your shell startup script this
 way:
@@ -547,13 +626,14 @@ If you are using C shell, you can do this as follows:
   /bin/csh
   perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc
 
-If you passed to bootstrap a directory other than default, you also need to give that as 
-import parameter to the call of the local::lib module like this way:
+If you passed to bootstrap a directory other than default, you also need to
+give that as import parameter to the call of the local::lib module like this
+way:
 
   echo 'eval $(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)' >>~/.bashrc
 
 After writing your shell configuration file, be sure to re-read it to get the
-changed settings into your current shell's environment. Bourne shells use 
+changed settings into your current shell's environment. Bourne shells use
 C<. ~/.bashrc> for this, whereas C shells use C<source ~/.cshrc>.
 
 If you're on a slower machine, or are operating under draconian disk space
@@ -562,9 +642,9 @@ installing modules by using the C<--no-manpages> argument when bootstrapping:
 
   perl Makefile.PL --bootstrap --no-manpages
 
-To avoid doing several bootstrap for several Perl module environments on the 
-same account, for example if you use it for several different deployed 
-applications independently, you can use one bootstrapped local::lib 
+To avoid doing several bootstrap for several Perl module environments on the
+same account, for example if you use it for several different deployed
+applications independently, you can use one bootstrapped local::lib
 installation to install modules in different directories directly this way:
 
   cd ~/mydir1
@@ -615,11 +695,11 @@ C<CMD.exe>, you can use this:
   C:\>perl -Mlocal::lib
   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 PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5
   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
@@ -651,7 +731,7 @@ packages takes precedence over the system installation.
 If you are using a package management system (such as Debian), you don't need to
 worry about Debian and CPAN stepping on each other's toes.  Your local version
 of the packages will be written to an entirely separate directory from those
-installed by Debian.  
+installed by Debian.
 
 =head1 DESCRIPTION
 
@@ -681,10 +761,10 @@ values:
 
 =item PATH
 
-PATH is appended to, rather than clobbered.
-
 =back
 
+When possible, these will be appended to instead of overwritten entirely.
+
 These values are then available for reference by any code after import.
 
 =head1 CREATING A SELF-CONTAINED SET OF MODULES
@@ -709,6 +789,17 @@ was added by C<local::lib>, instead of adding it.
 Remove all directories that were added to search paths by C<local::lib> from the
 search paths.
 
+=head2 --shelltype
+
+Specify the shell type to use for output.  By default, the shell will be
+detected based on the environment.  Should be one of: C<bourne>, C<csh>,
+C<cmd>, or C<powershell>.
+
+=head2 --no-create
+
+Prevents C<local::lib> from creating directories when activating dirs.  This is
+likely to cause issues on Win32 systems.
+
 =head1 METHODS
 
 =head2 ensure_dir_structure_for
@@ -741,9 +832,9 @@ given path as the base directory.
 
 =over 4
 
-=item Arguments: $path, $interpolate
+=item Arguments: $path
 
-=item Return value: \%environment_vars
+=item Return value: %environment_vars
 
 =back
 
@@ -763,34 +854,33 @@ given path as the base directory.
 Constructs the C<%ENV> keys for the given path, by calling
 L</build_environment_vars_for>.
 
-=head2 install_base_perl_path
+=head2 active_paths
 
 =over 4
 
-=item Arguments: $path
+=item Arguments: None
 
-=item Return value: $install_base_perl_path
+=item Return value: @paths
 
 =back
 
-Returns a path describing where to install the Perl modules for this local
-library installation. Appends the directories C<lib> and C<perl5> to the given
-path.
+Returns a list of active C<local::lib> paths, according to the
+C<PERL_LOCAL_LIB_ROOT> environment variable and verified against
+what is really in C<@INC>.
 
-=head2 install_base_arch_path
+=head2 install_base_perl_path
 
 =over 4
 
 =item Arguments: $path
 
-=item Return value: $install_base_arch_path
+=item Return value: $install_base_perl_path
 
 =back
 
-Returns a path describing where to install the architecture-specific Perl
-modules for this local library installation. Based on the
-L</install_base_perl_path> method's return value, and appends the value of
-C<$Config{archname}>.
+Returns a path describing where to install the Perl modules for this local
+library installation. Appends the directories C<lib> and C<perl5> to the given
+path.
 
 =head2 install_base_bin_path
 
@@ -803,8 +893,7 @@ C<$Config{archname}>.
 =back
 
 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>.
+local library installation. Appends the directory C<bin> to the given path.
 
 =head2 resolve_empty_path
 
@@ -875,28 +964,34 @@ install UNINST=1" and local::lib if you understand these possible consequences.
 
 =head1 LIMITATIONS
 
-The perl toolchain is unable to handle directory names with spaces in it,
-so you cant put your local::lib bootstrap into a directory with spaces. What
-you can do is moving your local::lib to a directory with spaces B<after> you
-installed all modules inside your local::lib bootstrap. But be aware that you
-cant update or install CPAN modules after the move.
+=over 4
 
-Rather basic shell detection. Right now anything with csh in its name is
+=item * Directory names with spaces in them are not well supported by the perl
+toolchain and the programs it uses.  Pure-perl distributions should support
+spaces, but problems are more likely with dists that require compilation. A
+workaround you can do is moving your local::lib to a directory with spaces
+B<after> you installed all modules inside your local::lib bootstrap. But be
+aware that you can't update or install CPAN modules after the move.
+
+=item * Rather basic shell detection. Right now anything with csh in its name is
 assumed to be a C shell or something compatible, and everything else is assumed
 to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is
 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.
+=item * Kills any existing PERL_MM_OPT or PERL_MB_OPT.
 
-Kills any existing PERL5LIB, PERL_MM_OPT or PERL_MB_OPT.
+=item * Should probably auto-fixup CPAN config if not already done.
 
-Should probably auto-fixup CPAN config if not already done.
+=back
 
 Patches very much welcome for any of the above.
 
-On Win32 systems, does not have a way to write the created environment variables
-to the registry, so that they can persist through a reboot.
+=over 4
+
+=item * On Win32 systems, does not have a way to write the created environment
+variables to the registry, so that they can persist through a reboot.
+
+=back
 
 =head1 TROUBLESHOOTING
 
@@ -929,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:
@@ -947,8 +1050,8 @@ Patches to correctly output commands for csh style shells, as well as some
 documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>.
 
 Doc patches for a custom local::lib directory, more cleanups in the english
-documentation and a L<german documentation|POD2::DE::local::lib> contributed by Torsten Raudssus
-<torsten@raudssus.de>.
+documentation and a L<german documentation|POD2::DE::local::lib> contributed by
+Torsten Raudssus <torsten@raudssus.de>.
 
 Hans Dieter Pearcey <hdp@cpan.org> sent in some additional tests for ensuring
 things will install properly, submitted a fix for the bug causing problems with
@@ -970,12 +1073,15 @@ Mark Stosberg <mark@summersault.com> provided the code for the now deleted
 Documentation patches to make win32 usage clearer by
 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>.
+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
@@ -983,9 +1089,7 @@ listed above.
 
 =head1 LICENSE
 
-This library is free software and may be distributed under the same terms
-as perl itself.
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
 
 =cut
-
-1;