[patch@31735]Archive Extract fix on VMS.
John E. Malmberg [Mon, 20 Aug 2007 22:05:11 +0000 (17:05 -0500)]
From: "John E. Malmberg" <wb8tyw@qsl.net>
Message-id: <46CA5667.2050207@qsl.net>

Quote -Z for unzip.

p4raw-id: //depot/perl@31747

lib/Archive/Extract.pm
lib/Archive/Extract/t/01_Archive-Extract.t

index d3a18ea..9b74e05 100644 (file)
@@ -17,6 +17,9 @@ use Locale::Maketext::Simple    Style => 'gettext';
 use constant ON_SOLARIS     => $^O eq 'solaris' ? 1 : 0;
 use constant FILE_EXISTS    => sub { -e $_[0] ? 1 : 0 };
 
+### VMS may require quoting upper case command options
+use constant ON_VMS         => $^O eq 'VMS' ? 1 : 0;
+
 ### If these are changed, update @TYPES and the new() POD
 use constant TGZ            => 'tgz';
 use constant TAR            => 'tar';
@@ -851,7 +854,12 @@ sub _unzip_bin {
 
 
     ### first, get the files.. it must be 2 different commands with 'unzip' :(
-    {   my $cmd = [ $self->bin_unzip, '-Z', '-1', $self->archive ];
+    {   my $cmd;
+       if (ON_VMS) {
+           $cmd = [ $self->bin_unzip, '"-Z"', '-1', $self->archive ];
+       } else {
+           $cmd = [ $self->bin_unzip, '-Z', '-1', $self->archive ];
+       }
 
         my $buffer = '';
         unless( scalar run( command => $cmd,
index e0912f4..71f712f 100644 (file)
@@ -362,6 +362,10 @@ for my $switch (0,1) {
                         ### if something went wrong with determining the out
                         ### path, don't go deleting stuff.. might be Really Bad
                         my $out_re = quotemeta( $OutDir );
+
+                       # Remove the directory terminator from regex
+                       my $out_re = s/\\\]// if IS_VMS;
+
                         if( $ae->extract_path !~ /^$out_re/ ) {   
                             ok( 0, "Extractpath WRONG (".$ae->extract_path.")"); 
                             skip(  "Unsafe operation -- skip cleanup!!!" ), 1;