X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Flocal%2Flib.pm;h=e1d3dddfb4c12ffa3baed75626d38222b00e83ff;hb=b3b52443a9cccaeff0446325e6080a75658e3cc3;hp=38ebcb50520c01f3322a7b9a9a785b983d863035;hpb=a27f74569232aedbe0a104c26fb7d99c8049686b;p=p5sagit%2Flocal-lib.git diff --git a/lib/local/lib.pm b/lib/local/lib.pm index 38ebcb5..e1d3ddd 100644 --- a/lib/local/lib.pm +++ b/lib/local/lib.pm @@ -3,14 +3,12 @@ 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_024'; # 1.8.24 +our $VERSION = '1.008026'; # 1.8.26 $VERSION = eval $VERSION; our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all); @@ -154,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) { @@ -180,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/; @@ -209,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 @@ -268,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 { @@ -363,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);