From 4f3b9739f9aa4291e372527205413c88e84985b9 Mon Sep 17 00:00:00 2001 From: "John E. Malmberg" Date: Mon, 20 Aug 2007 17:05:11 -0500 Subject: [PATCH] [patch@31735]Archive Extract fix on VMS. From: "John E. Malmberg" Message-id: <46CA5667.2050207@qsl.net> Quote -Z for unzip. p4raw-id: //depot/perl@31747 --- lib/Archive/Extract.pm | 10 +++++++++- lib/Archive/Extract/t/01_Archive-Extract.t | 4 ++++ 2 files changed, 13 insertions(+), 1 deletion(-) 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; -- 2.7.4