| Subject: | PATCH for VMS (changes I made to get tests to pass) |
Hello and thanks for Archive::Zip 1.23
I've attached the changes I made to get the tests to pass on VMS.
Cheers,
Peter (Stig) Edwards
| Subject: | archive_zip_1_23_VMS.patch |
==== Archive-Zip-1.23/lib/Archive/Zip.pm#2 (xtext) ====
@@ -500,10 +500,13 @@
my $forceDir = shift;
my $volReturn = shift;
my ( $volume, $directories, $file ) =
- File::Spec->splitpath( File::Spec->canonpath($name), $forceDir );
+ File::Spec::Unix->splitpath( File::Spec::Unix->canonpath($name), $forceDir );
$$volReturn = $volume if ( ref($volReturn) );
- my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec->splitdir($directories);
+ my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec::Unix->splitdir($directories);
if ( @dirs > 0 ) { pop (@dirs) unless $dirs[-1] } # remove empty component
+ if($^O eq 'VMS'){
+ if ( @dirs > 0 ) { shift (@dirs) unless $dirs[0] } # remove empty component
+ }
push ( @dirs, defined($file) ? $file : '' );
#return wantarray ? @dirs : join ( '/', @dirs );
return join ( '/', @dirs );
==== Archive-Zip-1.23/lib/Archive/Zip/Archive.pm#2 (xtext) ====
@@ -318,7 +318,7 @@
$fh = undef;
if ( $status != AZ_OK ) {
- unlink($tempName);
+ 1 while unlink($tempName);
_printError("Can't write to $tempName");
return $status;
}
@@ -328,7 +328,7 @@
# rename the zip
if ( -f $zipName && !rename( $zipName, $backupName ) ) {
$err = $!;
- unlink($tempName);
+ 1 while unlink($tempName);
return _error( "Can't rename $zipName as $backupName", $err );
}
@@ -336,14 +336,16 @@
unless ( File::Copy::move( $tempName, $zipName ) ) {
$err = $!;
rename( $backupName, $zipName );
- unlink($tempName);
+ 1 while unlink($tempName);
return _error( "Can't move $tempName to $zipName", $err );
}
# unlink the backup
- if ( -f $backupName && !unlink($backupName) ) {
- $err = $!;
- return _error( "Can't unlink $backupName", $err );
+ if ( -f $backupName ) {
+ 1 while unlink($backupName);
+ if(-e $backupName){
+ return _error( "Can't unlink $backupName", $! );
+ }
}
return AZ_OK;
==== Archive-Zip-1.23/t/02_main.t#2 (xtext) ====
@@ -487,7 +487,7 @@
my $fh;
if ($catWorks)
{
- unlink( OUTPUTZIP );
+ 1 while unlink( OUTPUTZIP );
$fh = FileHandle->new( CATPIPE . OUTPUTZIP );
binmode($fh);
}
==== Archive-Zip-1.23/t/03_ex.t#2 (xtext) ====
@@ -8,10 +8,11 @@
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use File::Spec;
use IO::File;
+use Config;
use Test::More tests => 17;
BEGIN {
- unshift @INC, "t/";
+ unshift @INC, "t/";
require( File::Spec->catfile('t', 'common.pl') )
or die "Can't load t/common.pl";
}
@@ -19,17 +20,22 @@
sub runPerlCommand
{
my $libs = join ( ' -I', @INC );
- my $cmd = "\"$^X\" \"-I$libs\" -w \"". join('" "', @_). '"';
+ my $this_perl = $^X;
+ if ($^O ne 'VMS'){
+ $this_perl .= $Config{_exe} unless $this_perl =~ m/$Config{_exe}$/i;
+ }
+
+ my $cmd = "$this_perl \"-I$libs\" \"-w\" \"". join('" "', @_). '"';
my $output = `$cmd`;
return wantarray ? ( $?, $output ) : $?;
}
-use constant FILENAME => File::Spec->catpath( '', TESTDIR, 'testing.txt' );
+use constant FILENAME => File::Spec->catfile( TESTDIR, 'testing.txt' );
use constant ZFILENAME => TESTDIR . "/testing.txt"; # name in zip
my $zip = Archive::Zip->new();
isa_ok( $zip, 'Archive::Zip' );
-$zip->addString( TESTSTRING, FILENAME );
+$zip->addString( TESTSTRING, ZFILENAME );
$zip->writeToFileNamed(INPUTZIP);
my ( $status, $output );
@@ -64,9 +70,9 @@
# removed because requires IO::Scalar
# ok( runPerlCommand('examples/readScalar.pl'), 0 );
-unlink(OUTPUTZIP);
+1 while unlink(OUTPUTZIP);
is( runPerlCommand( 'examples/selfex.pl', OUTPUTZIP, FILENAME ), 0 );
-unlink(FILENAME);
+1 while unlink(FILENAME);
is( runPerlCommand(OUTPUTZIP), 0 );
my $fn =
File::Spec->catpath( '', File::Spec->catdir( 'extracted', TESTDIR ),
@@ -79,9 +85,14 @@
# zipcheck.pl
# ziprecent.pl
-unlink(OUTPUTZIP);
+1 while unlink(OUTPUTZIP);
is( runPerlCommand( 'examples/updateTree.pl', OUTPUTZIP, TESTDIR ), 0, "updateTree.pl create" );
is( -f OUTPUTZIP, 1, "zip created" );
is( runPerlCommand( 'examples/updateTree.pl', OUTPUTZIP, TESTDIR ), 0, "updateTree.pl update" );
-is( -f OUTPUTZIP, 1, "zip updated" );
-unlink(OUTPUTZIP);
+SKIP: {
+ skip 'Running on VMS',1,if ($^O eq 'VMS');
+ is( -f OUTPUTZIP, 1, "zip updated" );
+}
+if(-e OUTPUTZIP){
+ 1 while unlink(OUTPUTZIP);
+}
==== Archive-Zip-1.23/t/06_update.t#2 (xtext) ====
@@ -23,11 +23,18 @@
my $zip = Archive::Zip->new();
my $testDir = File::Spec->catpath( $testFileVolume, $testFileDirs, '' );
+if($^O eq 'VMS'){
+ $testDir = 't';
+}
my $numberOfMembers = 0;
my @memberNames;
-sub countMembers { unless ($_ eq '.')
- { push(@memberNames, $_); $numberOfMembers++; } };
+sub countMembers {
+ unless ( ($_ eq '.') || ($_ eq '[]') ) {
+ push(@memberNames, $_);
+ $numberOfMembers++;
+ }
+};
File::Find::find( \&countMembers, $testDir );
is( $numberOfMembers > 1, 1, 'not enough members to test');
@@ -42,6 +49,9 @@
# add a file to the directory
$testFileName = File::Spec->catpath( $testFileVolume, $testFileDirs, 'xxxxxx' );
+if($^O eq 'VMS'){
+ $testFileName = File::Spec->catfile( $testDir, 'xxxxxx' );
+}
my $fh = IO::File->new( $testFileName, 'w');
$fh->print('xxxx');
undef($fh);
@@ -52,7 +62,7 @@
is( scalar($zip->members()), $numberOfMembers + 1, 'wrong number of members after update' );
# Delete the file.
-unlink($testFileName);
+1 while unlink($testFileName);
is( -f $testFileName, undef, "deleting $testFileName failed");
# updating without the mirror option should keep the members
==== Archive-Zip-1.23/t/07_filenames_of_0.t#2 (xtext) ====
@@ -32,12 +32,16 @@
my $archive = Archive::Zip->new;
$archive->addTree(
- File::Spec->catfile('testdir', 'folder'),
+ File::Spec::Unix->catfile('testdir', 'folder'),
'folder',
);
# TEST
-ok(scalar(grep { $_ eq "folder/0" } $archive->memberNames()),
+my $dot = q{};
+if($^O eq 'VMS'){
+ $dot = q{.};
+}
+ok(scalar(grep { $_ eq "folder/0$dot" } $archive->memberNames()),
"Checking that a file called '0' was added properly"
);
==== Archive-Zip-1.23/t/common.pl#2 (xtext) ====
@@ -148,6 +148,9 @@
#--------- check to see if cat works
sub testCat {
+ if($^O eq 'VMS'){
+ return 0;
+ }
my $fh = IO::File->new( CATPIPE . OUTPUTZIP );
binmode($fh);
my $testString = pack( 'C256', 0 .. 255 );
@@ -158,7 +161,7 @@
my @stat = stat(OUTPUTZIP);
$stat[7] == length($testString) or return 0;
fileCRC(OUTPUTZIP) == $testCrc or return 0;
- unlink(OUTPUTZIP);
+ 1 while unlink(OUTPUTZIP);
return 1;
}
@@ -172,7 +175,7 @@
#--------- check to see if zip works (and make INPUTZIP)
BEGIN {
- unlink(INPUTZIP);
+ 1 while unlink(INPUTZIP);
# Do we have zip installed?
if ( HAVEZIP ) {