}
sub _remove_from {
my ($list, @remove) = @_;
+ return @$list
+ if !@remove;
my %remove = map { $_ => 1 } @remove;
grep !$remove{$_}, _as_list($list);
}
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;
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);
$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;
- 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;
&& ${$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;
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';
}
}
/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
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<App::local::lib::Win32Helper>.
The "~" is translated to the user's profile directory (the directory named for
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<Invoke-Expression> cmdlet.
+
+ Invoke-Expression "$(perl -Mlocal::lib)"
+
=head1 RATIONALE
The version of a Perl package on your machine is not always the version you