diff options
| -rwxr-xr-x | Porting/Maintainers.pl | 2 | ||||
| -rw-r--r-- | cpan/Archive-Tar/bin/ptar | 8 | ||||
| -rw-r--r-- | cpan/Archive-Tar/lib/Archive/Tar.pm | 2 | ||||
| -rw-r--r-- | cpan/Archive-Tar/lib/Archive/Tar/Constant.pm | 2 | ||||
| -rw-r--r-- | cpan/Archive-Tar/lib/Archive/Tar/File.pm | 2 | ||||
| -rw-r--r-- | cpan/Archive-Tar/t/09_roundtrip.t | 110 |
6 files changed, 99 insertions, 27 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index e062d88bbf..3a097af8ef 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -120,7 +120,7 @@ use File::Glob qw(:case); %Modules = ( 'Archive::Tar' => { - 'DISTRIBUTION' => 'BINGOS/Archive-Tar-2.10.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Archive-Tar-2.12.tar.gz', 'FILES' => q[cpan/Archive-Tar], 'BUGS' => 'bug-archive-tar@rt.cpan.org', 'EXCLUDED' => [ diff --git a/cpan/Archive-Tar/bin/ptar b/cpan/Archive-Tar/bin/ptar index 9dc6402c66..67d4130171 100644 --- a/cpan/Archive-Tar/bin/ptar +++ b/cpan/Archive-Tar/bin/ptar @@ -94,12 +94,12 @@ sub usage { =head1 NAME - ptar - a tar-like program written in perl +ptar - a tar-like program written in perl =head1 DESCRIPTION - ptar is a small, tar look-alike program that uses the perl module - Archive::Tar to extract, create and list tar archives. +ptar is a small, tar look-alike program that uses the perl module +Archive::Tar to extract, create and list tar archives. =head1 SYNOPSIS @@ -123,7 +123,7 @@ sub usage { =head1 SEE ALSO - tar(1), L<Archive::Tar>. +L<tar(1)>, L<Archive::Tar>. =cut diff --git a/cpan/Archive-Tar/lib/Archive/Tar.pm b/cpan/Archive-Tar/lib/Archive/Tar.pm index 11582704bb..1731cb217c 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar.pm @@ -31,7 +31,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD $DEBUG = 0; $WARN = 1; $FOLLOW_SYMLINK = 0; -$VERSION = "2.10"; +$VERSION = "2.12"; $CHOWN = 1; $CHMOD = 1; $SAME_PERMISSIONS = $> == 0 ? 1 : 0; diff --git a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm index 3727bc32a1..bd62e029d3 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm @@ -3,7 +3,7 @@ package Archive::Tar::Constant; BEGIN { require Exporter; - $VERSION = '2.10'; + $VERSION = '2.12'; @ISA = qw[Exporter]; require Time::Local if $^O eq "MacOS"; diff --git a/cpan/Archive-Tar/lib/Archive/Tar/File.pm b/cpan/Archive-Tar/lib/Archive/Tar/File.pm index 3acc4f80f5..ef9eb06f5a 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar/File.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar/File.pm @@ -13,7 +13,7 @@ use Archive::Tar::Constant; use vars qw[@ISA $VERSION]; #@ISA = qw[Archive::Tar]; -$VERSION = '2.10'; +$VERSION = '2.12'; ### set value to 1 to oct() it during the unpack ### diff --git a/cpan/Archive-Tar/t/09_roundtrip.t b/cpan/Archive-Tar/t/09_roundtrip.t index 82cf444844..fd5eed40e8 100644 --- a/cpan/Archive-Tar/t/09_roundtrip.t +++ b/cpan/Archive-Tar/t/09_roundtrip.t @@ -9,35 +9,45 @@ use File::Temp qw( tempfile ); use Archive::Tar; -# tarballs available for testing -my @archives = ( +# Identify tarballs available for testing +# Some contain only files +# Others contain both files and directories + +my @file_only_archives = ( [qw( src short bar.tar )], - [qw( src long bar.tar )], - [qw( src linktest linktest_with_dir.tar )], ); -push @archives, - [qw( src short foo.tgz )], - [qw( src long foo.tgz )] +push @file_only_archives, [qw( src short foo.tgz )] if Archive::Tar->has_zlib_support; -push @archives, - [qw( src short foo.tbz )], - [qw( src long foo.tbz )] +push @file_only_archives, [qw( src short foo.tbz )] if Archive::Tar->has_bzip2_support; -@archives = map File::Spec->catfile(@$_), @archives; +@file_only_archives = map File::Spec->catfile(@$_), @file_only_archives; + +my @file_and_directory_archives = ( + [qw( src long bar.tar )], + [qw( src linktest linktest_with_dir.tar )], +); +push @file_and_directory_archives, [qw( src long foo.tgz )] + if Archive::Tar->has_zlib_support; +push @file_and_directory_archives, [qw( src long foo.tbz )] + if Archive::Tar->has_bzip2_support; + +@file_and_directory_archives = map File::Spec->catfile(@$_), @file_and_directory_archives; + +my @archives = (@file_only_archives, @file_and_directory_archives); plan tests => scalar @archives; # roundtrip test -for my $archive (@archives) { +for my $archive_name (@file_only_archives) { # create a new tarball with the same content as the old one - my $old = Archive::Tar->new($archive); + my $old = Archive::Tar->new($archive_name); my $new = Archive::Tar->new(); $new->add_files( $old->get_files ); # save differently if compressed - my $ext = ( split /\./, $archive )[-1]; + my $ext = ( split /\./, $archive_name )[-1]; my @compress = $ext =~ /t?gz$/ ? (COMPRESS_GZIP) : $ext =~ /(tbz|bz2?)$/ ? (COMPRESS_BZIP) @@ -49,14 +59,76 @@ for my $archive (@archives) { # read the archive again from disk $new = Archive::Tar->new($filename); - TODO: { - local $TODO = 'Need to work out why no trailing slash'; - # compare list of files is_deeply( [ $new->list_files ], [ $old->list_files ], - "$archive roundtrip on file names" + "$archive_name roundtrip on file names" ); - }; +} + +# rt.cpan.org #115160 +# t/09_roundtrip.t was added with all 7 then existent tests marked TODO even +# though 3 of them were passing. So what was really TODO was to figure out +# why the other 4 were not passing. +# +# It turns out that the tests are expecting behavior which, though on the face +# of it plausible and desirable, is not Archive::Tar::write()'s current +# behavior. write() -- which is used in the unit tests in this file -- relies +# on Archive::Tar::File::_prefix_and_file(). Since at least 2006 this helper +# method has had the effect of removing a trailing slash from archive entries +# which are in fact directories. So we have to adjust our expectations for +# what we'll get when round-tripping on an archive which contains one or more +# entries for directories. + +for my $archive_name (@file_and_directory_archives) { + my @contents; + if ($archive_name =~ m/\.tar$/) { + @contents = qx{tar tvf $archive_name}; + } + elsif ($archive_name =~ m/\.tgz$/) { + @contents = qx{tar tzvf $archive_name}; + } + elsif ($archive_name =~ m/\.tbz$/) { + @contents = qx{tar tjvf $archive_name}; + } + chomp(@contents); + my @directory_or_not; + for my $entry (@contents) { + my $perms = (split(/\s+/ => $entry))[0]; + my @chars = split('' => $perms); + push @directory_or_not, + ($chars[0] eq 'd' ? 1 : 0); + } + + # create a new tarball with the same content as the old one + my $old = Archive::Tar->new($archive_name); + my $new = Archive::Tar->new(); + $new->add_files( $old->get_files ); + + # save differently if compressed + my $ext = ( split /\./, $archive_name )[-1]; + my @compress = + $ext =~ /t?gz$/ ? (COMPRESS_GZIP) + : $ext =~ /(tbz|bz2?)$/ ? (COMPRESS_BZIP) + : (); + + my ( $fh, $filename ) = tempfile( UNLINK => 1 ); + $new->write( $filename, @compress ); + + # read the archive again from disk + $new = Archive::Tar->new($filename); + + # Adjust our expectations of + my @oldfiles = $old->list_files; + for (my $i = 0; $i <= $#oldfiles; $i++) { + chop $oldfiles[$i] if $directory_or_not[$i]; + } + + # compare list of files + is_deeply( + [ $new->list_files ], + [ @oldfiles ], + "$archive_name roundtrip on file names" + ); } |