Upgrade to Archive::Tar 1.26
Rafael Garcia-Suarez [Mon, 22 Aug 2005 10:09:40 +0000 (10:09 +0000)]
Preserve some local typo fixes
Don't load Data::Dumper

p4raw-id: //depot/perl@25312

MANIFEST
lib/Archive/Tar.pm
lib/Archive/Tar/Constant.pm
lib/Archive/Tar/File.pm
lib/Archive/Tar/bin/ptar
lib/Archive/Tar/bin/ptardiff [new file with mode: 0644]
lib/Archive/Tar/t/02_methods.t
lib/Archive/Tar/t/04_resolved_issues.t [new file with mode: 0644]

index 7f46fb9..8cfade5 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1186,10 +1186,12 @@ lib/assert.pl                   assertion and panic with stack trace
 lib/Archive/Tar/Constant.pm    Archive::Tar
 lib/Archive/Tar/File.pm                Archive::Tar
 lib/Archive/Tar/bin/ptar       the ptar utility
+lib/Archive/Tar/bin/ptardiff   the ptardiff utility
 lib/Archive/Tar/t/00_setup.t   Archive::Tar test setup
 lib/Archive/Tar/t/01_use.t     Archive::Tar tests
 lib/Archive/Tar/t/02_methods.t Archive::Tar tests
 lib/Archive/Tar/t/03_file.t    Archive::Tar tests
+lib/Archive/Tar/t/04_resolved issues.t Archive::Tar tests
 lib/Archive/Tar/t/99_clean.t   Archive::Tar test cleanup
 lib/Archive/Tar/t/src/long/b   Archive::Tar tests
 lib/Archive/Tar/t/src/short/b  Archive::Tar tests
index 9064f2b..28338df 100644 (file)
@@ -14,7 +14,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
 $DEBUG              = 0;
 $WARN               = 1;
 $FOLLOW_SYMLINK     = 0;
-$VERSION            = "1.24_02";
+$VERSION            = "1.26_01";
 $CHOWN              = 1;
 $CHMOD              = 1;
 $DO_NOT_USE_PREFIX  = 0;
@@ -110,7 +110,10 @@ sub new {
     my $obj = bless { _data => [ ], _file => 'Unknown' }, $class;
 
     if (@_) {
-        return unless $obj->read( @_ );
+        unless ( $obj->read( @_ ) ) {
+            $obj->_error(qq[No data could be read from file]);
+            return;
+        }
     }
 
     return $obj;
@@ -259,10 +262,19 @@ sub _read_tar {
         ### source code (tar.c) to GNU cpio.
         next if $chunk eq TAR_END;
 
+        ### pass the realname, so we can set it 'proper' right away
+        ### some of the heuristics are done on the name, so important
+        ### to set it ASAP
         my $entry;
-        unless( $entry = Archive::Tar::File->new( chunk => $chunk ) ) {
-            $self->_error( qq[Couldn't read chunk at offset $offset] );
-            next;
+        {   my %extra_args = ();
+            $extra_args{'name'} = $$real_name if defined $real_name;
+            
+            unless( $entry = Archive::Tar::File->new(   chunk => $chunk, 
+                                                        %extra_args ) 
+            ) {
+                $self->_error( qq[Couldn't read chunk at offset $offset] );
+                next;
+            }
         }
 
         ### ignore labels:
@@ -497,7 +509,14 @@ sub _extract_file {
     } else {
         my @dirs    = File::Spec::Unix->splitdir( $dirs );
         my @cwd     = File::Spec->splitdir( $cwd );
-        $dir        = File::Spec->catdir(@cwd, @dirs);
+        $dir        = File::Spec->catdir( @cwd, @dirs );
+
+        # catdir() returns undef if the path is longer than 255 chars on VMS
+        unless ( defined $dir ) {
+            $^W && $self->_error( qq[Could not compose a path for '$dirs'\n] );
+            return;
+        }
+
     }
 
     if( -e $dir && !-d _ ) {
@@ -1439,6 +1458,46 @@ have incompatible filetypes and still expect things to work).
 For other filetypes, like C<chardevs> and C<blockdevs> we'll warn that
 the extraction of this particular item didn't work.
 
+=item How do I access .tar.Z files?
+
+The C<Archive::Tar> module can optionally use C<Compress::Zlib> (via
+the C<IO::Zlib> module) to access tar files that have been compressed
+with C<gzip>. Unfortunately tar files compressed with the Unix C<compress>
+utility cannot be read by C<Compress::Zlib> and so cannot be directly
+accesses by C<Archive::Tar>.
+
+If the C<uncompress> or C<gunzip> programs are available, you can use
+one of these workarounds to read C<.tar.Z> files from C<Archive::Tar>
+
+Firstly with C<uncompress>
+
+    use Archive::Tar;
+
+    open F, "uncompress -c $filename |";
+    my $tar = Archive::Tar->new(*F);
+    ...
+
+and this with C<gunzip>
+
+    use Archive::Tar;
+
+    open F, "gunzip -c $filename |";
+    my $tar = Archive::Tar->new(*F);
+    ...
+
+Similarly, if the C<compress> program is available, you can use this to
+write a C<.tar.Z> file
+
+    use Archive::Tar;
+    use IO::File;
+
+    my $fh = new IO::File "| compress -c >$filename";
+    my $tar = Archive::Tar->new();
+    ...
+    $tar->write($fh);
+    $fh->close ;
+
+
 =back
 
 =head1 TODO
index f7f0f6d..3112d59 100644 (file)
@@ -62,7 +62,12 @@ use constant MAGIC          => "ustar";
 use constant TAR_VERSION    => "00";
 use constant LONGLINK_NAME  => '././@LongLink';
 
-use constant ZLIB           => do { eval { require IO::Zlib }; $@ ? 0 : 1 };
+                            ### allow ZLIB to be turned off using ENV
+                            ### DEBUG only
+use constant ZLIB           => do { !$ENV{'PERL5_AT_NO_ZLIB'} and
+                                        eval { require IO::Zlib };
+                                    $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 };
+                                    
 use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/;
 
 use constant CAN_CHOWN      => do { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
index a310ee9..42b0860 100644 (file)
@@ -2,9 +2,10 @@ package Archive::Tar::File;
 use strict;
 
 use IO::File;
-use File::Spec::Unix ();
-use File::Spec ();
-use File::Basename ();
+use File::Spec::Unix    ();
+use File::Spec          ();
+use File::Basename      ();
+
 use Archive::Tar::Constant;
 
 use vars qw[@ISA $VERSION];
@@ -200,6 +201,12 @@ sub clone {
 sub _new_from_chunk {
     my $class = shift;
     my $chunk = shift or return;
+    my %hash  = @_;
+
+    ### filter any arguments on defined-ness of values.
+    ### this allows overriding from what the tar-header is saying
+    ### about this tar-entry. Particularly useful for @LongLink files
+    my %args  = map { $_ => $hash{$_} } grep { defined $hash{$_} } keys %hash;
 
     ### makes it start at 0 actually... :) ###
     my $i = -1;
@@ -207,7 +214,7 @@ sub _new_from_chunk {
         $tmpl->[++$i] => $tmpl->[++$i] ? oct $_ : $_
     } map { /^([^\0]*)/ } unpack( UNPACK, $chunk );
 
-    my $obj = bless \%entry, $class;
+    my $obj = bless { %entry, %args }, $class;
 
        ### magic is a filetype string.. it should have something like 'ustar' or
        ### something similar... if the chunk is garbage, skip it
index 8947257..014d2f7 100644 (file)
@@ -28,34 +28,34 @@ if( $opts->{c} ) {
     my @files;
     find( sub { push @files, $File::Find::name;
                 print $File::Find::name.$/ if $verbose }, @ARGV );
-
-    Archive::Tar->create_archive( $file, $compress, @files );
+                
+    Archive::Tar->create_archive( $file, $compress, @files );              
     exit;
-}
+} 
 
 my $tar = Archive::Tar->new($file, $compress);
 
 if( $opts->{t} ) {
-    print map { $_->full_path . $/ } $tar->get_files;
+    print map { $_->full_path . $/ } $tar->get_files; 
 
-} elsif( $opts->{x} ) {
+} elsif( $opts->{x} ) {    
     print map { $_->full_path . $/ } $tar->get_files
         if $verbose;
     Archive::Tar->extract_archive($file, $compress);
-}
+}    
 
 
 
 sub usage {
     qq[
-Usage:  ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
-        ptar -x [-v] [-z] [-f ARCHIVE_FILE]
-        ptar -t [-z] [-f ARCHIVE_FILE]
+Usage:  ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...      
+        ptar -x [-v] [-z] [-f ARCHIVE_FILE] 
+        ptar -t [-z] [-f ARCHIVE_FILE] 
         ptar -h
-
+    
     ptar is a small, tar look-alike program that uses the perl module
-    Archive::Tar to extract, create and list tar archives.
-
+    Archive::Tar to extract, create and list tar archives.    
+    
 Options:
     x   Extract from ARCHIVE_FILE
     c   Create ARCHIVE_FILE from FILE
@@ -72,34 +72,3 @@ See Also:
     \n]
 }
 
-=head1 NAME
-
-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.
-
-=head1 SYNOPSIS
-
-    ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
-    ptar -x [-v] [-z] [-f ARCHIVE_FILE]
-    ptar -t [-z] [-f ARCHIVE_FILE]
-    ptar -h
-
-=head1 OPTIONS
-
-    x   Extract from ARCHIVE_FILE
-    c   Create ARCHIVE_FILE from FILE
-    t   List the contents of ARCHIVE_FILE
-    f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
-    z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
-    v   Print filenames as they are added or extraced from ARCHIVE_FILE
-    h   Prints this help message
-
-=head1 SEE ALSO
-
-tar(1), L<Archive::Tar>.
-
-=cut
diff --git a/lib/Archive/Tar/bin/ptardiff b/lib/Archive/Tar/bin/ptardiff
new file mode 100644 (file)
index 0000000..19c9b90
--- /dev/null
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use Archive::Tar;
+use Getopt::Std;
+
+my $opts = {};
+getopts('h:', $opts) or die usage();
+
+die usages() if $opts->{h};
+
+### need Text::Diff -- give a polite error (not a standard prereq)
+unless ( eval { require Text::Diff; Text::Diff->import; 1 } ) {
+    die "\n\t This tool requires the 'Text::Diff' module to be installed\n";
+}
+
+my $arch = shift                        or die usage();
+my $tar  = Archive::Tar->new( $arch )   or die "Couldn't read '$arch': $!";
+
+
+foreach my $file ( $tar->get_files ) {
+    next unless $file->is_file;
+    my $name = $file->name;
+    
+    diff(   \($file->get_content), $name, 
+            {   FILENAME_A  => $name,
+                MTIME_A     => $file->mtime,
+                OUTPUT      => \*STDOUT
+            } 
+    );
+}
+
+
+
+
+sub usage {
+    return q[
+
+Usage:  ptardiff ARCHIVE_FILE
+        ptardiff -h
+    
+    ptardiff is a small program that diffs an extracted archive
+    against an unextracted one, using the perl module Archive::Tar.
+    
+    This effectively lets you view changes made to an archives contents. 
+    
+    Provide the progam with an ARCHIVE_FILE and it will look up all
+    the files with in the archive, scan the current working directory
+    for a file with the name and diff it against the contents of the
+    archive.
+
+    
+Options:
+    h   Prints this help message
+
+
+Sample Usage:
+
+    $ tar -xzf Acme-Buffy-1.3.tar.gz 
+    $ vi Acme-Buffy-1.3/README
+    
+    [...]
+
+    $ ptardiff Acme-Buffy-1.3.tar.gz > README.patch
+
+
+See Also:
+    tar(1)
+    ptar
+    Archive::Tar
+
+    ] . $/;
+}    
index 3721025..9f9d667 100644 (file)
@@ -60,7 +60,7 @@ my @EXPECTX = (
 my $LONG_FILE = qq[directory/really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-long-directory-name/myfile];
 
 ### wintendo can't deal with too long paths, so we might have to skip tests ###
-my $TOO_LONG    =   ($^O eq 'MSWin32' or $^O eq 'cygwin')
+my $TOO_LONG    =   ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'VMS')
                     && length( cwd(). $LONG_FILE ) > 247;
 
 ### warn if we are going to skip long file names
@@ -85,12 +85,11 @@ my $TGZ_FILE        = File::Spec->catfile( @ROOT, 'foo.tgz' );
 my $OUT_TAR_FILE    = File::Spec->catfile( @ROOT, 'out.tar' );
 my $OUT_TGZ_FILE    = File::Spec->catfile( @ROOT, 'out.tgz' );
 
-copy( File::Basename::basename($0), 'copy' );
-my $COMPRESS_FILE   = 'copy';
+my $COMPRESS_FILE = 'copy';
+$^O eq 'VMS' and $COMPRESS_FILE .= '.';
+copy( File::Basename::basename($0), $COMPRESS_FILE );
 chmod 0644, $COMPRESS_FILE;
 
-END { unlink $COMPRESS_FILE; }
-
 ### done setting up environment ###
 
 
@@ -221,7 +220,7 @@ END { unlink $COMPRESS_FILE; }
         is( scalar @files, scalar @add,
                                     "Adding files");
         is( $files[0]->name, 'b',   "   Proper name" );
-        is( $files[0]->is_file, !-l $add[0] && -f _,  "   Proper type" );
+        is( $files[0]->is_file, 1,  "   Proper type" );
         like( $files[0]->get_content, qr/^bbbbbbbbbbb\s*$/,
                                     "   Content OK" );
 
@@ -559,6 +558,7 @@ END {
 
     my ($dir) = File::Spec::Unix->splitdir( $LONG_FILE );
     rmtree $dir if $dir && -d $dir && not $NO_UNLINK;
+    1 while unlink $COMPRESS_FILE;
 }
 
 ###########################
@@ -581,7 +581,11 @@ sub is_dir {
 
 sub rm {
     my $x = shift;
-    is_dir($x) ? rmtree($x) : unlink $x;
+    if  ( is_dir($x) ) {
+         rmtree($x);
+    } else {
+         1 while unlink $x;
+    }
 }
 
 sub check_tar_file {
@@ -680,8 +684,7 @@ sub check_tar_extract {
         like( $content, qr/$econtent/,
                                     "   Contents OK" );
 
-        close $fh;
-        unlink $path unless $NO_UNLINK;
+        $NO_UNLINK or 1 while unlink $path;
 
         ### alternate extract path tests 
         ### to abs and rel paths
@@ -690,8 +693,8 @@ sub check_tar_extract {
                                     File::Spec->catdir( @ROOT )
                                 )
             ) {
-            
-                my $outfile = File::Spec->catfile( $outpath, $$ ); 
+
+                my $outfile = File::Spec->catfile( $outpath, $$ );
     
                 ok( $tar->extract_file( $file->full_path, $outfile ),
                                 "   Extracted file '$path' to $outfile" );
diff --git a/lib/Archive/Tar/t/04_resolved_issues.t b/lib/Archive/Tar/t/04_resolved_issues.t
new file mode 100644 (file)
index 0000000..865cf04
--- /dev/null
@@ -0,0 +1,59 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
+    }       
+    use lib '../../..';
+}
+
+BEGIN { chdir 't' if -d 't' }
+
+use Test::More 'no_plan';
+use strict;
+use lib '../lib';
+
+my $NO_UNLINK   = @ARGV ? 1 : 0;
+
+my $Class       = 'Archive::Tar';
+
+use_ok( $Class );
+
+### bug #13636
+### tests for @longlink behaviour on files that have a / at the end
+### of their shortened path, making them appear to be directories
+{   ### dont use the prefix, otherwise A::T will not use @longlink
+    ### encoding style
+    local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
+    local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
+    
+    my $dir =   'Catalyst-Helper-Controller-Scaffold-HTML-Template-0.03/' . 
+                'lib/Catalyst/Helper/Controller/Scaffold/HTML/';
+    my $file =  'Template.pm';
+    my $out =   $$ . '.tar';
+    
+    ### first create the file
+    {   my $tar = $Class->new;
+        
+        isa_ok( $tar,           $Class );
+        ok( $tar->add_data( $dir.$file => $$ ),
+                                "   Added long file" );
+        
+        ok( $tar->write($out),  "   File written to $out" );
+    }
+    
+    ### then read it back in
+    {   my $tar = $Class->new;
+        isa_ok( $tar,           $Class );
+        ok( $tar->read( $out ), "   Read in $out again" );
+        
+        my @files = $tar->get_files;
+        is( scalar(@files), 1,  "   Only 1 entry found" );
+        
+        my $entry = shift @files;
+        ok( $entry->is_file,    "   Entry is a file" );
+        is( $entry->name, $dir.$file,
+                                "   With the proper name" );
+    }                                
+    
+    ### remove the file
+    unless( $NO_UNLINK ) { 1 while unlink $out }
+}