X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Flocal%2Flib.pm;h=c5b799552feea997a1a381f57c28598bcd7bfd23;hb=c6611e1c90fb9afe371ebf7f4e9b88eb35acc574;hp=68baba797153836b26bf6a2948bcdd1057a8b38e;hpb=4e1bf182fbcc68084cabf865cea917a7e1897e68;p=p5sagit%2Flocal-lib.git diff --git a/lib/local/lib.pm b/lib/local/lib.pm index 68baba7..c5b7995 100644 --- a/lib/local/lib.pm +++ b/lib/local/lib.pm @@ -16,6 +16,7 @@ sub import { my @steps; my %opts; + my $shelltype; while (@args) { my $arg = shift @args; @@ -32,7 +33,17 @@ dashes with normal minus signs. DEATH } 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"; + die <<'DEATH'; +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). +DEATH } elsif( $arg =~ /^--deactivate(?:=(.*))?$/ ) { my $path = defined $1 ? $1 : shift @args; @@ -42,8 +53,7 @@ DEATH push @steps, ['deactivate_all']; } elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) { - my $shell = defined $1 ? $1 : shift @args; - $opts{shelltype} = $shell; + $shelltype = defined $1 ? $1 : shift @args; } elsif ( $arg eq '--no-create' ) { $opts{no_create} = 1; @@ -67,11 +77,11 @@ DEATH } if ($0 eq '-') { - $self->print_environment_vars_for; + print $self->environment_vars_string($shelltype); exit 0; } else { - $self->setup_local_lib_for; + $self->setup_local_lib; } } @@ -160,8 +170,10 @@ sub _mb_escape_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, + PERL_MM_OPT => + defined $path ? "INSTALL_BASE="._mm_escape_path($path) : undef, + PERL_MB_OPT => + defined $path ? "--install_base "._mb_escape_path($path) : undef, }; } @@ -181,6 +193,7 @@ 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; @@ -190,9 +203,12 @@ sub deactivate { } 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)) ], + 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) ], ); @@ -232,8 +248,7 @@ sub activate { $self->ensure_dir_structure_for($path) unless $self->no_create; - $path = ( Win32::GetShortPathName($path) || $path ) - if $^O eq 'MSWin32'; + $path = $self->normalize_path($path); my @active_lls = $self->active_paths; @@ -256,17 +271,19 @@ sub activate { $self->clone(%args); } -sub _legacy { +sub normalize_path { my ($self, $path) = @_; - $self = $self->new unless ref $self; - if (defined $path) { - $self = $self->activate($path); - } - $self; + $path = ( Win32::GetShortPathName($path) || $path ) + if $^O eq 'MSWin32'; + return $path; } sub build_environment_vars_for { - my ($self) = _legacy(@_); + my $self = $_[0]->new->activate($_[1]); + $self->build_environment_vars; +} +sub build_environment_vars { + my $self = shift; ( PATH => join($_path_sep, _as_list($self->bins)), PERL5LIB => join($_path_sep, _as_list($self->libs)), @@ -276,14 +293,23 @@ sub build_environment_vars_for { } sub setup_local_lib_for { - my ($self) = _legacy(@_); - $self->setup_env_hash_for; + my $self = $_[0]->new->activate($_[1]); + $self->setup_local_lib; +} + +sub setup_local_lib { + my $self = shift; + $self->setup_env_hash; @INC = @{$self->inc}; } sub setup_env_hash_for { + my $self = $_[0]->new->activate($_[1]); + $self->setup_env_hash; +} +sub setup_env_hash { my $self = shift; - my %env = $self->build_environment_vars_for(@_); + my %env = $self->build_environment_vars; for my $key (keys %env) { if (defined $env{$key}) { $ENV{$key} = $env{$key}; @@ -295,14 +321,19 @@ sub setup_env_hash_for { } sub print_environment_vars_for { - my $self = shift; - print $self->environment_vars_string_for(@_); + print $_[0]->environment_vars_string_for(@_[1..$#_]); } sub environment_vars_string_for { - my $self = _legacy(@_); + my $self = $_[0]->new->activate($_[1]); + $self->environment_vars_string; +} +sub environment_vars_string { + my ($self, $shelltype) = @_; + + $shelltype ||= $self->guess_shelltype; - my $build_method = 'build_' . $self->shelltype . '_env_declaration'; + my $build_method = "build_${shelltype}_env_declaration"; my @envs = ( PATH => $self->bins, @@ -340,64 +371,89 @@ sub environment_vars_string_for { sub build_bourne_env_declaration { my ($class, $name, $args) = @_; - my $value = $class->_interpolate($args); - 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, undef, undef, '"', qq{"\\"}); - (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, '%', '%', qr([()!^"<>&|]), '^'); - defined $value - ? qq{set $name=$value\n} - : qq{set $name=\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:', '', '"', '`'); - defined $value - ? qq{\$env:$name = "$value";\n} - : "Remove-Item Env:\\$name;\n"; + my $value = $class->_interpolate($args, '$env:%s', '"', '`%s'); + + if (!$value) { + return qq{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, $escape, $escape_char) = @_; + 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; - $escape = '"' unless defined $escape; - $escape_char = "\\" unless defined $escape_char; - my @vars; - my $string = join($Config{path_sep}, map { - if (ref $_ && ref $_ eq 'SCALAR') { - push @vars, $$_; - $start.$$_.$end; - } - else { - my $str = $_; - $str =~ s/($escape)/$escape_char$1/g; - $str; - } - } @$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; @@ -556,12 +612,12 @@ sub guess_shelltype { for ($shellbin) { return - /csh/ ? 'csh' - : /command\.com/ ? 'cmd' - : /cmd\.exe/ ? 'cmd' - : /4nt\.exe/ ? 'cmd' - : /powershell\.exe/ ? 'powershell' - : 'bourne'; + /csh/ ? 'csh' + : /command\.com/i ? 'cmd' + : /cmd\.exe/i ? 'cmd' + : /4nt\.exe/i ? 'cmd' + : /powershell\.exe/i ? 'powershell' + : 'bourne'; } } @@ -647,7 +703,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 @@ -725,7 +781,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 @@ -734,6 +790,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