Update Archive-Tar to CPAN version 2.12
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Tue, 18 Oct 2016 09:10:41 +0000 (10:10 +0100)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Tue, 18 Oct 2016 09:10:41 +0000 (10:10 +0100)
  [DELTA]

2.12  16/10/2016 (KHW && JKEENAN)
- Fix pod in bin/ptar
- Distinguish between archives with/without directory entries

Porting/Maintainers.pl
cpan/Archive-Tar/bin/ptar
cpan/Archive-Tar/lib/Archive/Tar.pm
cpan/Archive-Tar/lib/Archive/Tar/Constant.pm
cpan/Archive-Tar/lib/Archive/Tar/File.pm
cpan/Archive-Tar/t/09_roundtrip.t

index e062d88..3a097af 100755 (executable)
@@ -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'     => [
index 9dc6402..67d4130 100644 (file)
@@ -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
 
index 1158270..1731cb2 100644 (file)
@@ -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;
index 3727bc3..bd62e02 100644 (file)
@@ -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";
index 3acc4f8..ef9eb06 100644 (file)
@@ -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 ###
 
index 82cf444..fd5eed4 100644 (file)
@@ -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"
+    );
 }