move win32 path shortening back to correct location
[p5sagit/local-lib.git] / lib / local / lib.pm
index 34e5806..f5e4778 100644 (file)
@@ -3,32 +3,22 @@ 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 Config;
 
-our $VERSION = '1.008_025'; # 1.8.25
+our $VERSION = '1.008026'; # 1.8.26
 $VERSION = eval $VERSION;
 
-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) = @_;
 
-  # 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
     # the fancy dash is U+2212 or \xE2\x88\x92
     if ($arg =~ /\xE2\x88\x92/ or $arg =~ /−/) {
@@ -41,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;
+  }
+  else {
+    $self->setup_local_lib_for;
   }
-  if ($arg_store{'deactivate-all'}) {
-    $deactivating = DEACTIVATE_ALL;
+}
+
+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;
+}
 
-  $arg_store{path} = $class->resolve_path($arg_store{path});
-  $class->setup_local_lib_for($arg_store{path}, $deactivating);
+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,
+  };
+}
 
-  for (@INC) { # Untaint @INC
-    next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
-    m/(.*)/ and $_ = $1;
+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);
+
+  my @active_lls = $self->active_paths;
+
+  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;
@@ -108,18 +410,16 @@ Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
 
 =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 {
@@ -154,25 +454,13 @@ 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) {
@@ -180,7 +468,6 @@ sub resolve_home_path {
     Carp::croak(
       "Couldn't resolve homedir for "
       .(defined $user ? $user : 'current user')
-      .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
     );
   }
   $path =~ s/^~[^\/]*/$homedir/;
@@ -203,361 +490,19 @@ is($c->resolve_relative_path('bar'),'FOObar');
 
 =cut
 
-sub setup_local_lib_for {
-  my ($class, $path, $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[0] 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, $interpolate);
-    exit 0;
-  } else {
-    $class->setup_env_hash_for($path, $deactivating);
-    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
-    );
-  }
-}
-
-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);
-  return
-}
-
-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, $interpolate) = @_;
-  print $class->environment_vars_string_for($path, $deactivating, $interpolate);
-}
-
-sub environment_vars_string_for {
-  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
-  # 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);
-  }
-}
-
-# 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 =>
-            _env_list_value(
-              { interpolate => $interpolate, exists => 0, empty => '' },
-              $path,
-              \'PERL_LOCAL_LIB_ROOT',
-            ),
-    PERL_MB_OPT => "--install_base " . _mb_escape_path($path),
-    PERL_MM_OPT => "INSTALL_BASE=" . _mm_escape_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 _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 active_paths {
-  my ($class) = @_;
-
-  return () unless defined $ENV{PERL_LOCAL_LIB_ROOT};
-
-  return grep {
-    # screen out entries that aren't actually reflected in @INC
-    my $active_ll = $class->install_base_perl_path($_);
-    grep { $_ eq $active_ll } @INC
+  require File::Basename;
+  my @dirs;
+  while(!-d $path) {
+    push @dirs, $path;
+    $path = File::Basename::dirname($path);
   }
-  grep { $_ ne '' }
-  split /\Q$Config{path_sep}\E/, $ENV{PERL_LOCAL_LIB_ROOT};
-}
-
-sub build_deactivate_environment_vars_for {
-  my ($class, $path, $interpolate) = @_;
-
-  my @active_lls = $class->active_paths;
-
-  if (!grep { $_ eq $path } @active_lls) {
-    warn "Tried to deactivate inactive local::lib '$path'\n";
-    return ();
-  }
-
-  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 => _env_list_value(
-      {
-        exists => 0,
-      },
-      grep { $_ ne $path } @active_lls
-    ),
-    PERL5LIB => _env_list_value(
-      {
-        exists => 0,
-        filter => sub {
-          $_ ne $perl_path && $_ ne $arch_path
-        },
-      },
-      \'PERL5LIB',
-    ),
-    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[0] eq $path) {
-    my $new_top = $active_lls[1];
-    $env{PERL_MB_OPT} = defined($new_top) ? "--install_base "._mb_escape_path($new_top) : undef;
-    $env{PERL_MM_OPT} = defined($new_top) ? "INSTALL_BASE="._mm_escape_path($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;
+  mkdir $_ for reverse @dirs;
+  return;
 }
 
 =begin testing
@@ -572,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
@@ -599,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
@@ -653,8 +626,9 @@ 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
 
@@ -721,7 +695,7 @@ 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
@@ -787,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
@@ -815,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
@@ -847,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
 
@@ -897,21 +882,6 @@ 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_arch_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $install_base_arch_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}>.
-
 =head2 install_base_bin_path
 
 =over 4
@@ -923,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
 
@@ -997,21 +966,19 @@ install UNINST=1" and local::lib if you understand these possible consequences.
 
 =over 4
 
-=item * The perl toolchain is unable to handle directory names with spaces in it,
-so you can't 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
-can't update or install CPAN modules after the move.
+=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.
 
-=item * Bootstrap is a hack and will use CPAN.pm for ExtUtils::MakeMaker even if you
-have CPANPLUS installed.
-
-=item * Kills any existing PERL5LIB, PERL_MM_OPT or PERL_MB_OPT.
+=item * Kills any existing PERL_MM_OPT or PERL_MB_OPT.
 
 =item * Should probably auto-fixup CPAN config if not already done.
 
@@ -1021,8 +988,8 @@ Patches very much welcome for any of the above.
 
 =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.
+=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
 
@@ -1083,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
@@ -1106,13 +1073,14 @@ 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>.
+Patch for Carp version mismatch contributed by Hakim Cassimally
+<osfameron@cpan.org>.
 
 =head1 COPYRIGHT
 
@@ -1125,5 +1093,3 @@ 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;