don't leave empty segments in paths in sh/csh
[p5sagit/local-lib.git] / lib / local / lib.pm
index 41a51d6..10e7cad 100644 (file)
@@ -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);
 }
@@ -184,7 +186,7 @@ sub deactivate {
 
   if (!grep { $_ eq $path } @active_lls) {
     warn "Tried to deactivate inactive local::lib '$path'\n";
-    return;
+    return $self;
   }
 
   my %args = (
@@ -205,15 +207,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,18 +232,24 @@ sub activate {
   $self->ensure_dir_structure_for($path)
     unless $self->no_create;
 
+  $path = ( Win32::GetShortPathName($path) || $path )
+    if $^O eq 'MSWin32';
+
   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);
 
@@ -310,67 +321,103 @@ 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 $joined;
+  for (@$value) {
+    if (!defined $joined) {
+      $joined = $_;
+    }
+    elsif ($_ eq "\$$name") {
+      $joined .= "\${$name+$Config{path_sep}}$_";
+    }
+    else {
+      $joined .= "$Config{path_sep}$_";
+    }
+  }
+  defined $value
+    ? qq{export ${name}="$joined";\n}
+    : qq{unset ${name};\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, undef, undef, '"', qq{"\\"});
+
+  my $out = '';
+  if (@vars) {
+    $out = qq{if \$?$name };
+  }
+  $out .= defined $value ? qq{setenv $name "}.join($Config{path_sep},@$value).qq{";\n} : qq{unsetenv $name;\n};
+  if (@vars) {
+    my $no_var = $class->_interpolate([ grep { !ref } @$args ], undef, undef, '"', qq{"\\"});
+    if (defined $no_var) {
+      $out .= qq{if ! \$?$name setenv $name "}.join($Config{path_sep},@$no_var).qq{";\n};
+    }
+  }
+  $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, '%', '%', qr([()!^"<>&|]), '^');
+  defined $value
+    ? qq{\@set $name=}.join($Config{path_sep},@$value).qq{\n}
+    : qq{\@set $name=\n};
 }
 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};
-  }
-  return "Remove-Item Env:\\$name\n";
+  my $value = $class->_interpolate($args, '$env:', '', '"', '`');
+  defined $value
+    ? qq{\$env:$name = "}.join($Config{path_sep},@$value).qq{";\n}
+    : "Remove-Item Env:\\$name;\n";
+}
+sub wrap_powershell_output {
+  my ($class, $out) = @_;
+  return $out || " \n";
 }
 
 
 sub _interpolate {
-  my ($class, $args, $start, $end) = @_;
+  my ($class, $args, $start, $end, $escape, $escape_char) = @_;
   return
     unless defined $args;
-  return $args
+  $args = [ $args ]
     unless ref $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 {
-    (ref $_ && ref $_ eq 'SCALAR') ? do { push @vars, $$_; $start.$$_.$end }
-      : $_
-  } @$args);
+  my $string = [ 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;
 }
 
@@ -416,9 +463,6 @@ sub resolve_path {
     resolve_empty_path
   )}($path);
 
-  $path = Win32::GetShortPathName($path)
-    if $^O eq 'MSWin32';
-
   $path;
 }
 
@@ -520,38 +564,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 $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
-                 }
-         };
+  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/    ? 'cmd'
+      : /cmd\.exe/        ? 'cmd'
+      : /4nt\.exe/        ? 'cmd'
+      : /powershell\.exe/ ? 'powershell'
+                          : 'bourne';
   }
-  return $shelltype;
 }
 
 1;
@@ -636,7 +668,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 +746,7 @@ C<CMD.exe>, 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<App::local::lib::Win32Helper>.
 
 The "~" is translated to the user's profile directory (the directory named for
@@ -723,6 +755,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<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