diff options
| author | John E. Malmberg <wb8tyw@qsl.net> | 2007-08-20 17:05:11 -0500 |
|---|---|---|
| committer | Craig A. Berry <craigberry@mac.com> | 2007-08-22 11:20:52 +0000 |
| commit | 4f3b9739f9aa4291e372527205413c88e84985b9 (patch) | |
| tree | 7d46dc94e5bca3f77bd06a07b5ce3b08d4576dd0 /lib/Archive | |
| parent | 4492be7a152d0913edcc816c5354cda7f7039baf (diff) | |
| download | perl-4f3b9739f9aa4291e372527205413c88e84985b9.tar.gz | |
[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
Diffstat (limited to 'lib/Archive')
| -rw-r--r-- | lib/Archive/Extract.pm | 10 | ||||
| -rw-r--r-- | lib/Archive/Extract/t/01_Archive-Extract.t | 4 |
2 files changed, 13 insertions, 1 deletions
diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm index d3a18ea3ed..9b74e059f9 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 e0912f4d2e..71f712fa8d 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; |