From: Graham Knop <haarg@haarg.org>
Date: Tue, 22 Oct 2013 12:11:43 +0000 (-0400)
Subject: fix installing to directories with spaces and backslashes
X-Git-Tag: 1.008024~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=93b577b582750b1e84d1bfaf916e2d0f5ef9d0ba;p=p5sagit%2Flocal-lib.git

fix installing to directories with spaces and backslashes
---

diff --git a/lib/local/lib.pm b/lib/local/lib.pm
index 8e41cf7..9ac0a75 100644
--- a/lib/local/lib.pm
+++ b/lib/local/lib.pm
@@ -424,8 +424,8 @@ sub build_activate_environment_vars_for {
               \'PERL_LOCAL_LIB_ROOT',
               $path,
             ),
-    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 => '' },
@@ -440,6 +440,21 @@ sub build_activate_environment_vars_for {
   )
 }
 
+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) = @_;
 
@@ -498,8 +513,8 @@ sub build_deactivate_environment_vars_for {
   # 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;
+    $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;
diff --git a/t/install.t b/t/install.t
index 1ee35d0..874e3e1 100644
--- a/t/install.t
+++ b/t/install.t
@@ -3,43 +3,61 @@ use warnings;
 use Test::More;
 BEGIN { plan skip_all => "Install Capture::Tiny to test installation"
   unless eval { require Capture::Tiny; 1 } }
-use Capture::Tiny qw(capture);
+use Capture::Tiny qw(capture_merged);
 use File::Spec;
+use File::Path qw(mkpath);
 use Cwd;
 use Config;
 
 use lib 't/lib'; use TempDir;
 
-plan tests => 2;
+use local::lib ();
 
-my $dir = mk_temp_dir('test_local_lib-XXXXX');
+my @dirs = (
+  'plain',
+  'with space',
+  'with\backslash',
+  'with space\and-bs',
+);
 
-use local::lib ();
-local::lib->import($dir);
+my %dist_types = (
+  EUMM => sub {
+    system($^X, 'Makefile.PL') && die "Makefile.PL failed";
+    system($Config{make}, 'install') && die "$Config{make} install failed";
+  },
+  MB => sub {
+    system($^X, 'Build.PL') && die "Build.PL failed";
+    system($^X, 'Build', 'install') && die "Build install failed";
+  },
+);
+
+plan tests => @dirs * keys(%dist_types) * 2;
 
 my $orig_dir = cwd;
-SKIP: for my $dist_type (qw(MB EUMM)) {
-  chdir File::Spec->catdir($orig_dir, qw(t dist), $dist_type);
-  if ($dist_type eq 'EUMM') {
-    my ($stdout, $stderr) = capture { eval {
-      system($^X, 'Makefile.PL') && die "Makefile.PL failed";
-      system($Config{make}, 'install') && die "$Config{make} install failed";
-    } };
-    diag $stdout, $stderr if $@;
-  } else {
-    my ($stdout, $stderr) = capture { eval {
-      system($^X, 'Build.PL') && die "Build.PL failed";
-      system($^X, 'Build', 'install') && die "Build install failed";
+for my $dir_base (@dirs) {
+  for my $dist_type (sort keys %dist_types) {
+    chdir $orig_dir;
+    my $temp = mk_temp_dir('test_local_lib-XXXXX');
+    my $ll_dir = "$dist_type-$dir_base";
+    mkpath(my $ll = "$temp/$ll_dir");
+    local::lib->import($ll);
+
+    chdir File::Spec->catdir($orig_dir, qw(t dist), $dist_type);
+    my $output = capture_merged { eval {
+      $dist_types{$dist_type}->();
     } };
-    diag $stdout, $stderr if $@;
+    is $@, '', "installed $dist_type into '$ll_dir'"
+      or diag $output;
+
+    my $dest_dir = local::lib->install_base_perl_path($ll);
+    my $file = File::Spec->catfile($dest_dir, "$dist_type.pm");
+    (my $short_file = $file) =~ s/^\Q$ll/$ll_dir/;
+    ok(
+      -e $file,
+      "$dist_type - $dir_base - $dist_type.pm installed as '$short_file'",
+    ) or diag 'Files in ' . $dest_dir . ":\n", join("\n", do {
+      my $dh;
+      (opendir $dh, $dest_dir) ? readdir $dh : "doesn't exist";
+    });
   }
-  my $file = File::Spec->catfile($dir, qw(lib perl5), "$dist_type.pm");
-  ok(
-    -e $file,
-    "$dist_type - $dist_type.pm installed as $file",
-  )
-  or do {
-        my $dest_dir = File::Spec->catdir($dir, qw(lib perl5));
-        diag 'Files in ' . $dest_dir . ":\n", join("\n", glob(File::Spec->catfile($dest_dir, '*')));
-  };
 }