Skip Menu |
 

This queue is for tickets about the Archive-Zip CPAN distribution.

Report information
The Basics
Id: 36430
Status: open
Priority: 0/
Queue: Archive-Zip

People
Owner: Nobody in particular
Requestors: cpan [...] pjedwards.co.uk
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: 1.23
Fixed in: (no value)



Subject: PATCH for VMS (changes I made to get tests to pass)
Download (untitled) / with headers
text/plain 133b
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 ) {
Subject: Re: [rt.cpan.org #36430] PATCH for VMS (changes I made to get tests to pass)
Date: Wed, 4 Jun 2008 07:51:45 -0500
To: bug-Archive-Zip [...] rt.cpan.org
From: "Steve Peters" <steve [...] fisharerojo.org>
Download (untitled) / with headers
text/plain 787b
On Wed, Jun 4, 2008 at 5:05 AM, Peter John Edwards via RT <bug-Archive-Zip@rt.cpan.org> wrote: Show quoted text
> > Wed Jun 04 06:05:43 2008: Request 36430 was acted upon. > Transaction: Ticket created by cpan@pjedwards.co.uk > Queue: Archive-Zip > Subject: PATCH for VMS (changes I made to get tests to pass) > Broken in: 1.23 > Severity: (no value) > Owner: Nobody > Requestors: cpan@pjedwards.co.uk > Status: new > Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=36430 > > > > 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 >
Thanks! I'll see if I can get Craig Berry, the perl5-porters VMS guy, to try out Archive-Zip and this patch. Steve Peters steve@fisharerojo.org
Download (untitled) / with headers
text/plain 1008b
On Wed Jun 04 08:52:08 2008, steve@fisharerojo.org wrote: Show quoted text
> On Wed, Jun 4, 2008 at 5:05 AM, Peter John Edwards via RT > <bug-Archive-Zip@rt.cpan.org> wrote:
> > > > Wed Jun 04 06:05:43 2008: Request 36430 was acted upon. > > Transaction: Ticket created by cpan@pjedwards.co.uk > > Queue: Archive-Zip > > Subject: PATCH for VMS (changes I made to get tests to pass) > > Broken in: 1.23 > > Severity: (no value) > > Owner: Nobody > > Requestors: cpan@pjedwards.co.uk > > Status: new > > Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=36430 > > > > > > > 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 > >
> > Thanks! I'll see if I can get Craig Berry, the perl5-porters VMS guy, > to try out Archive-Zip and this patch. > > Steve Peters > steve@fisharerojo.org
I've attached the changes I made to get the tests to pass on VMS, for 1.31_01. Cheers, Peter (Stig) Edwards
Subject: vms_changes_for_archive_zip_1_31_01.txt
==== archive-zip-1_31_01/lib/archive/zip.pm#1 - archive-zip-1_31_01.lib.archive]zip.pm ==== 519c519 < File::Spec->splitpath( File::Spec->canonpath($name), $forceDir ); --- > File::Spec::Unix->splitpath( File::Spec::Unix->canonpath($name), $forceDir ); 521c521 < my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec->splitdir($directories); --- > my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec::Unix->splitdir($directories); 522a523,525 > if($^O eq 'VMS'){ > if ( @dirs > 0 ) { shift (@dirs) unless $dirs[0] } # remove empty component > } ==== archive-zip-1_31_01/lib/archive/zip/archive.pm#1 - archive-zip-1_31_01.lib.archive.zip]archive.pm ==== 469c469 < unlink($tempName); --- > 1 while(unlink($tempName)); 479c479 < unlink($tempName); --- > 1 while(unlink($tempName)); 487c487 < unlink($tempName); --- > 1 while(unlink($tempName)); 492,494c492,496 < 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", $! ); > } ==== archive-zip-1_31_01/t/02_main.t#1 - archive-zip-1_31_01.t]02_main.t ==== 491c491 < unlink( OUTPUTZIP ); --- > 1 while(unlink( OUTPUTZIP )); ==== archive-zip-1_31_01/t/03_ex.t#1 - archive-zip-1_31_01.t]03_ex.t ==== 10a11 > use Config; 22c23,27 < 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('" "', @_). '"'; 27c32 < use constant FILENAME => File::Spec->catpath( '', TESTDIR, 'testing.txt' ); --- > use constant FILENAME => File::Spec->catfile( TESTDIR, 'testing.txt' ); 32c37 < $zip->addString( TESTSTRING, FILENAME ); --- > $zip->addString( TESTSTRING, ZFILENAME ); 67c72 < unlink(OUTPUTZIP); --- > 1 while(unlink(OUTPUTZIP)); 69c74 < unlink(FILENAME); --- > 1 while(unlink(FILENAME)); 82c87 < unlink(OUTPUTZIP); --- > 1 while(unlink(OUTPUTZIP)); 86,87c91,97 < 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_31_01/t/06_update.t#1 - archive-zip-1_31_01.t]06_update.t ==== 25a26,28 > if($^O eq 'VMS'){ > $testDir = 't'; > } 29,30c32,37 < sub countMembers { unless ($_ eq '.') < { push(@memberNames, $_); $numberOfMembers++; } }; --- > sub countMembers { > unless ( ($_ eq '.') || ($_ eq '[]') ) { > push(@memberNames, $_); > $numberOfMembers++; > } > } 44a52,54 > if($^O eq 'VMS'){ > $testFileName = File::Spec->catfile( $testDir, 'xxxxxx' ); > } 55c65 < unlink($testFileName); --- > 1 while(unlink($testFileName)); ==== archive-zip-1_31_01/t/07_filenames_of_0.t#1 - archive-zip-1_31_01.t]07_filenames_of_0.t ==== 35c35 < File::Spec->catfile('testdir', 'folder'), --- > File::Spec::Unix->catfile('testdir', 'folder'), 40c40,44 < 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()), ==== archive-zip-1_31_01/t/09_output_record_sep.t#1 - archive-zip-1_31_01.t]09_output_record_sep.t ==== 14,15c14,15 < my $expected_fn = File::Spec->catfile( < File::Spec->curdir, "t", "badjpeg", "expected.jpg" --- > my $expected_fn = File::Spec::Unix->catfile( > File::Spec::Unix->curdir, "t", "badjpeg", "expected.jpg" 16a17 > 26,27c27,28 < open my $fh, "<$filename" < or die 'Can not open file'; --- > open my $fh, '<', $filename > or die qq{Can not open file '$filename'}; 89c90 < unlink $got_fn; --- > 1 while(unlink $got_fn); 111,112c112,113 < unlink $got_fn; < unlink $archive_fn; --- > 1 while(unlink $got_fn); > 1 while(unlink $archive_fn); ==== archive-zip-1_31_01/t/common.pl#1 - archive-zip-1_31_01.t]common.pl ==== 150a151,153 > if($^O eq 'VMS'){ > return 0; > } 161c164 < unlink(OUTPUTZIP); --- > 1 while (unlink(OUTPUTZIP)); 175c178 < unlink(INPUTZIP); --- > 1 while (unlink(INPUTZIP));


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.