From: John E. Malmberg <wb8tyw@qsl.net>
Date: Mon, 20 Aug 2007 22:05:11 +0000 (-0500)
Subject: [patch@31735]Archive Extract fix on VMS.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4f3b9739f9aa4291e372527205413c88e84985b9;p=p5sagit%2Fp5-mst-13.2.git

[patch@31735]Archive Extract fix on VMS.
From: "John E. Malmberg" <wb8tyw@qsl.net>
	Message-id: <46CA5667.2050207@qsl.net>

Quote -Z for unzip.

p4raw-id: //depot/perl@31747
---

diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm
index d3a18ea..9b74e05 100644
--- a/lib/Archive/Extract.pm
+++ b/lib/Archive/Extract.pm
@@ -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,
diff --git a/lib/Archive/Extract/t/01_Archive-Extract.t b/lib/Archive/Extract/t/01_Archive-Extract.t
index e0912f4..71f712f 100644
--- a/lib/Archive/Extract/t/01_Archive-Extract.t
+++ b/lib/Archive/Extract/t/01_Archive-Extract.t
@@ -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;