X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Flocal%2Flib.pm;h=e1d3dddfb4c12ffa3baed75626d38222b00e83ff;hb=b3b52443a9cccaeff0446325e6080a75658e3cc3;hp=03bd2d28234c380456366a0bf8c9d70bbbae5d47;hpb=6d7223bb6359b3150a6776488a8fab0a51bdd7e8;p=p5sagit%2Flocal-lib.git

diff --git a/lib/local/lib.pm b/lib/local/lib.pm
index 03bd2d2..e1d3ddd 100644
--- a/lib/local/lib.pm
+++ b/lib/local/lib.pm
@@ -3,14 +3,13 @@ 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.008014'; # 1.8.14
+our $VERSION = '1.008026'; # 1.8.26
+$VERSION = eval $VERSION;
 
 our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all);
 
@@ -153,25 +152,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) {
@@ -179,7 +166,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/;
@@ -208,7 +194,8 @@ sub setup_local_lib_for {
   my $interpolate = LITERAL_ENV;
   my @active_lls = $class->active_paths;
 
-  $class->ensure_dir_structure_for($path);
+  $class->ensure_dir_structure_for($path)
+    unless $deactivating;
 
   # On Win32 directories often contain spaces. But some parts of the CPAN
   # toolchain don't like that. To avoid this, GetShortPathName() gives us
@@ -217,7 +204,7 @@ sub setup_local_lib_for {
   $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
 
   if (! $deactivating) {
-    if (@active_lls && $active_lls[-1] eq $path) {
+    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) {
@@ -267,8 +254,14 @@ sub ensure_dir_structure_for {
   unless (-d $path) {
     warn "Attempting to create directory ${path}\n";
   }
-  File::Path::mkpath($path);
-  return
+  require File::Basename;
+  my @dirs;
+  while(!-d $path) {
+    push @dirs, $path;
+    $path = File::Basename::dirname($path);
+  }
+  mkdir $_ for reverse @dirs;
+  return;
 }
 
 sub guess_shelltype {
@@ -344,7 +337,7 @@ sub build_bourne_env_declaration {
 sub build_csh_env_declaration {
   my $class = shift;
   my($name, $value) = @_;
-  return defined($value) ? qq{setenv ${name} "${value}"\n} : qq{unsetenv ${name}\n};
+  return defined($value) ? qq{setenv ${name} "${value}";\n} : qq{unsetenv ${name};\n};
 }
 
 sub build_win32_env_declaration {
@@ -362,9 +355,9 @@ sub setup_env_hash_for {
 sub build_environment_vars_for {
   my ($class, $path, $deactivating, $interpolate) = @_;
 
-  if ($deactivating == DEACTIVATE_ONE) {
+  if ($deactivating && $deactivating == DEACTIVATE_ONE) {
     return $class->build_deactivate_environment_vars_for($path, $interpolate);
-  } elsif ($deactivating == DEACTIVATE_ALL) {
+  } elsif ($deactivating && $deactivating == DEACTIVATE_ALL) {
     return $class->build_deact_all_environment_vars_for($path, $interpolate);
   } else {
     return $class->build_activate_environment_vars_for($path, $interpolate);
@@ -420,11 +413,11 @@ sub build_activate_environment_vars_for {
     PERL_LOCAL_LIB_ROOT =>
             _env_list_value(
               { interpolate => $interpolate, exists => 0, empty => '' },
-              \'PERL_LOCAL_LIB_ROOT',
               $path,
+              \'PERL_LOCAL_LIB_ROOT',
             ),
-    PERL_MB_OPT => "--install_base ${path}",
-    PERL_MM_OPT => "INSTALL_BASE=${path}",
+    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 => '' },
@@ -439,6 +432,21 @@ sub build_activate_environment_vars_for {
   )
 }
 
+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) = @_;
 
@@ -495,10 +503,10 @@ sub build_deactivate_environment_vars_for {
 
   # 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) {
-    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;
+  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;
@@ -1105,8 +1113,8 @@ 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