X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Flocal%2Flib.pm;h=000f858d8606a4475e38cbd0b7ceb3bfa577ee68;hb=cf6fe9d6c1665748c77912aa005313273b0e1b39;hp=41a51d64dbf877926c12cbe94ebca7d4b6d83118;hpb=c40e10d7a5fafb4895f6228b5f6e532e3288fa09;p=p5sagit%2Flocal-lib.git diff --git a/lib/local/lib.pm b/lib/local/lib.pm index 41a51d6..000f858 100644 --- a/lib/local/lib.pm +++ b/lib/local/lib.pm @@ -109,6 +109,8 @@ sub _as_list { } sub _remove_from { my ($list, @remove) = @_; + return @$list + if !@remove; my %remove = map { $_ => 1 } @remove; grep !$remove{$_}, _as_list($list); } @@ -179,12 +181,13 @@ sub deactivate { my ($self, $path) = @_; $self = $self->new unless ref $self; $path = $self->resolve_path($path); + $path = $self->normalize_path($path); my @active_lls = $self->active_paths; if (!grep { $_ eq $path } @active_lls) { warn "Tried to deactivate inactive local::lib '$path'\n"; - return; + return $self; } my %args = ( @@ -205,15 +208,18 @@ sub deactivate_all { 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) ], - ); + my %args; + if (@active_lls) { + %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); @@ -227,24 +233,36 @@ sub activate { $self->ensure_dir_structure_for($path) unless $self->no_create; + $path = $self->normalize_path($path); + my @active_lls = $self->active_paths; - if (grep { $_ eq $path } @active_lls) { + if (grep { $_ eq $path } @active_lls[1 .. $#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} ], - ); + my %args; + if (!@active_lls || $active_lls[0] ne $path) { + %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 normalize_path { + my ($self, $path) = @_; + $path = ( Win32::GetShortPathName($path) || $path ) + if $^O eq 'MSWin32'; + return $path; +} + sub _legacy { my ($self, $path) = @_; $self = $self->new unless ref $self; @@ -310,68 +328,108 @@ sub environment_vars_string_for { && ${$value->[0]} eq $name) { next; } - if (!ref $value - && $value eq $ENV{$name}) { + if ( + !ref $value + and defined $value + ? (defined $ENV{$name} && $value eq $ENV{$name}) + : !defined $ENV{$name} + ) { next; } $out .= $self->$build_method($name, $value); } + my $wrap_method = 'wrap_' . $self->shelltype . '_output'; + if ($self->can($wrap_method)) { + return $self->$wrap_method($out); + } 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}; + my $value = $class->_interpolate($args, '$%s', '"', '\\%s'); + + if (!defined $value) { + return qq{unset $name;\n}; + } + + $value =~ s/(^|\G|$_path_sep)\$$name$_path_sep/$1\$$name\${$name+$_path_sep}/g; + $value =~ s/$_path_sep\$$name$/\${$name+$_path_sep}\$$name/; + + qq{export ${name}="$value";\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}); + my ($value, @vars) = $class->_interpolate($args, '$%s', '"', '"\\%s"'); + if (!defined $value) { + return qq{unsetenv $name;\n}; + } + + my $out = ''; + for my $var (@vars) { + $out .= qq{if ! \$?$name setenv $name '';\n}; + } + + my $value_without = $value; + if ($value_without =~ s/(?:^|$_path_sep)\$$name(?:$_path_sep|$)//g) { + $out .= qq{if "\$$name" != '' setenv $name "$value";\n}; + $out .= qq{if "\$$name" == '' }; + } + $out .= qq{setenv $name "$value_without";\n}; + return $out; } + 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"; + my $value = $class->_interpolate($args, '%%%s%%', qr([()!^"<>&|]), '^%s'); + if (!$value) { + return qq{\@set $name=\n}; + } + + my $out = ''; + my $value_without = $value; + if ($value_without =~ s/(?:^|$_path_sep)%$name%(?:$_path_sep|$)//g) { + $out .= qq{\@if not "%$name%"=="" set $name=$value\n}; + $out .= qq{\@if "%$name%"=="" }; + } + $out .= qq{\@set $name=$value_without\n}; + return $out; } + 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}; + my $value = $class->_interpolate($args, '$env:%s', '"', '`%s'); + + if (!$value) { + return qq{Remove-Item Env:\\$name;\n}; } - return "Remove-Item Env:\\$name\n"; -} + my $maybe_path_sep = qq{\$(if("\$env:$name"-eq""){""}else{"$_path_sep"})}; + $value =~ s/(^|\G|$_path_sep)\$env:$name$_path_sep/$1\$env:$name"+$maybe_path_sep+"/g; + $value =~ s/$_path_sep\$env:$name$/"+$maybe_path_sep+\$env:$name+"/; + + qq{\$env:$name = \$("$value");\n}; +} +sub wrap_powershell_output { + my ($class, $out) = @_; + return $out || " \n"; +} sub _interpolate { - my ($class, $args, $start, $end) = @_; + my ($class, $args, $var_pat, $escape, $escape_pat) = @_; return unless defined $args; - return $args - unless ref $args; + my @args = ref $args ? @$args : $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; + unless @args; + my @vars = map { $$_ } grep { ref $_ eq 'SCALAR' } @args; + my $string = join $_path_sep, map { + ref $_ eq 'SCALAR' ? sprintf($var_pat, $$_) : do { + s/($escape)/sprintf($escape_pat, $1)/ge; $_; + }; + } @args; + return wantarray ? ($string, \@vars) : $string; } sub pipeline; @@ -416,9 +474,6 @@ sub resolve_path { resolve_empty_path )}($path); - $path = Win32::GetShortPathName($path) - if $^O eq 'MSWin32'; - $path; } @@ -520,38 +575,26 @@ ok(-d 't/var/splat'); =cut 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 $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/i ? 'cmd' + : /cmd\.exe/i ? 'cmd' + : /4nt\.exe/i ? 'cmd' + : /powershell\.exe/i ? 'powershell' + : 'bourne'; } - 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/) { - 'cmd' - } elsif(/cmd\.exe/) { - 'cmd' - } elsif(/4nt\.exe/) { - 'cmd' - } else { - $shelltype - } - }; - } - return $shelltype; } 1; @@ -636,7 +679,7 @@ If you are using C shell, you can do this as follows: /bin/csh echo $SHELL /bin/csh - perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc + echo 'eval `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 @@ -714,7 +757,7 @@ C, you can use this: 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 +If you want the environment entries to persist, you'll need to add them to the Control Panel's System applet yourself or use L. The "~" is translated to the user's profile directory (the directory named for @@ -723,6 +766,13 @@ the user under "Documents and Settings" (Windows XP or earlier) or "Users" directory is translated to a short name (which means the directory must exist) and the subdirectories are created. +=head3 PowerShell + +local::lib also supports PowerShell, and an be used with the +C cmdlet. + + Invoke-Expression "$(perl -Mlocal::lib)" + =head1 RATIONALE The version of a Perl package on your machine is not always the version you