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);
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) {
Carp::croak(
"Couldn't resolve homedir for "
.(defined $user ? $user : 'current user')
- .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
);
}
$path =~ s/^~[^\/]*/$homedir/;
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
$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) {
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 {
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 {
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);
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 => '' },
)
}
+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) = @_;
# 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;
=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