Upgrade to Archive-Tar-1.39_04
Steve Hay [Wed, 1 Oct 2008 16:53:57 +0000 (16:53 +0000)]
Local change 32352 remains in 04_resolved_issues.t

p4raw-id: //depot/perl@34452

12 files changed:
MANIFEST
lib/Archive/Tar.pm
lib/Archive/Tar/Constant.pm
lib/Archive/Tar/File.pm
lib/Archive/Tar/bin/ptar
lib/Archive/Tar/t/02_methods.t
lib/Archive/Tar/t/05_iter.t [new file with mode: 0644]
lib/Archive/Tar/t/90_symlink.t [new file with mode: 0644]
lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed [new file with mode: 0644]
lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed [new file with mode: 0644]
lib/Archive/Tar/t/src/long/foo.tbz.packed [new file with mode: 0644]
lib/Archive/Tar/t/src/short/foo.tbz.packed [new file with mode: 0644]

index 01f80e0..b78f137 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1620,11 +1620,17 @@ 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/05_iter.t    Archive::Tar tests
+lib/Archive/Tar/t/90_symlink.t Archive::Tar tests
+lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed Archive::Tar tests
+lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed    Archive::Tar tests
 lib/Archive/Tar/t/src/long/b   Archive::Tar tests
 lib/Archive/Tar/t/src/long/bar.tar.packed      Archive::Tar tests
+lib/Archive/Tar/t/src/long/foo.tbz.packed      Archive::Tar tests
 lib/Archive/Tar/t/src/long/foo.tgz.packed      Archive::Tar tests
 lib/Archive/Tar/t/src/short/b  Archive::Tar tests
 lib/Archive/Tar/t/src/short/bar.tar.packed     Archive::Tar tests
+lib/Archive/Tar/t/src/short/foo.tbz.packed     Archive::Tar tests
 lib/Archive/Tar/t/src/short/foo.tgz.packed     Archive::Tar tests
 lib/assert.pl                  assertion and panic with stack trace
 lib/Attribute/Handlers/Changes Attribute::Handlers
index 508bcfe..1590ec7 100644 (file)
@@ -7,16 +7,31 @@
 package Archive::Tar;
 require 5.005_03;
 
+use Cwd;
+use IO::Zlib;
+use IO::File;
+use Carp                qw(carp croak);
+use File::Spec          ();
+use File::Spec::Unix    ();
+use File::Path          ();
+
+use Archive::Tar::File;
+use Archive::Tar::Constant;
+
+require Exporter;
+
 use strict;
 use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
             $DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING
-            $INSECURE_EXTRACT_MODE
+            $INSECURE_EXTRACT_MODE @ISA @EXPORT
          ];
 
+@ISA                    = qw[Exporter];
+@EXPORT                 = ( COMPRESS_GZIP, COMPRESS_BZIP );
 $DEBUG                  = 0;
 $WARN                   = 1;
 $FOLLOW_SYMLINK         = 0;
-$VERSION                = "1.38";
+$VERSION                = "1.39_04";
 $CHOWN                  = 1;
 $CHMOD                  = 1;
 $DO_NOT_USE_PREFIX      = 0;
@@ -28,24 +43,13 @@ BEGIN {
 
     ### try and load IO::String anyway, so you can dynamically
     ### switch between perlio and IO::String
-    eval {
+    $HAS_IO_STRING = eval {
         require IO::String;
         import IO::String;
-    };
-    $HAS_IO_STRING = $@ ? 0 : 1;
-
+        1;
+    } || 0;
 }
 
-use Cwd;
-use IO::File;
-use Carp                qw(carp croak);
-use File::Spec          ();
-use File::Spec::Unix    ();
-use File::Path          ();
-
-use Archive::Tar::File;
-use Archive::Tar::Constant;
-
 =head1 NAME
 
 Archive::Tar - module for manipulations of tar archives
@@ -55,7 +59,7 @@ Archive::Tar - module for manipulations of tar archives
     use Archive::Tar;
     my $tar = Archive::Tar->new;
 
-    $tar->read('origin.tgz',1);
+    $tar->read('origin.tgz');
     $tar->extract();
 
     $tar->add_files('file/foo.pl', 'docs/README');
@@ -63,7 +67,9 @@ Archive::Tar - module for manipulations of tar archives
 
     $tar->rename('oldname', 'new/file/name');
 
-    $tar->write('files.tar');
+    $tar->write('files.tar');                   # plain tar
+    $tar->write('files.tgz', COMPRESSED_GZIP);  # gzip compressed
+    $tar->write('files.tbz', COMPRESSED_BZIP);  # bzip2 compressed
 
 =head1 DESCRIPTION
 
@@ -122,23 +128,25 @@ sub new {
     return $obj;
 }
 
-=head2 $tar->read ( $filename|$handle, $compressed, {opt => 'val'} )
+=head2 $tar->read ( $filename|$handle, [$compressed, {opt => 'val'}] )
 
 Read the given tar file into memory.
 The first argument can either be the name of a file or a reference to
 an already open filehandle (or an IO::Zlib object if it's compressed)
-The second argument indicates whether the file referenced by the first
-argument is compressed.
 
 The C<read> will I<replace> any previous content in C<$tar>!
 
-The second argument may be considered optional if IO::Zlib is
-installed, since it will transparently Do The Right Thing.
-Archive::Tar will warn if you try to pass a compressed file if
-IO::Zlib is not available and simply return.
+The second argument may be considered optional, but remains for 
+backwards compatibility. Archive::Tar now looks at the file
+magic to determine what class should be used to open the file
+and will transparently Do The Right Thing.
+
+Archive::Tar will warn if you try to pass a bzip2 compressed file and the
+IO::Zlib / IO::Uncompress::Bunzip2 modules are not available and simply return.
 
 Note that you can currently B<not> pass a C<gzip> compressed
-filehandle, which is not opened with C<IO::Zlib>, nor a string
+filehandle, which is not opened with C<IO::Zlib>, a C<bzip2> compressed
+filehandle, which is not opened with C<IO::Uncompress::Bunzip2>, nor a string
 containing the full archive information (either compressed or
 uncompressed). These are worth while features, but not currently
 implemented. See the C<TODO> section.
@@ -153,12 +161,18 @@ all options are case-sensitive.
 Do not read more than C<limit> files. This is useful if you have
 very big archives, and are only interested in the first few files.
 
+=item filter
+
+Can be set to a regular expression.  Only files with names that match
+the expression will be read.
+
 =item extract
 
 If set to true, immediately extract entries when reading them. This
 gives you the same memory break as the C<extract_archive> function.
 Note however that entries will not be read into memory, but written
-straight to disk.
+straight to disk. This means no C<Archive::Tar::File> objects are 
+created for you to inspect.
 
 =back
 
@@ -194,49 +208,97 @@ sub read {
 }
 
 sub _get_handle {
-    my $self = shift;
-    my $file = shift;   return unless defined $file;
-                        return $file if ref $file;
-
-    my $gzip = shift || 0;
-    my $mode = shift || READ_ONLY->( ZLIB ); # default to read only
-
-    my $fh; my $bin;
-
-    ### only default to ZLIB if we're not trying to /write/ to a handle ###
-    if( ZLIB and $gzip || MODE_READ->( $mode ) ) {
-
-        ### IO::Zlib will Do The Right Thing, even when passed
-        ### a plain file ###
-        $fh = new IO::Zlib;
+    my $self     = shift;
+    my $file     = shift;   return unless defined $file;
+                            return $file if ref $file;
+    my $compress = shift || 0;
+    my $mode     = shift || READ_ONLY->( ZLIB ); # default to read only
+
+
+    ### get a FH opened to the right class, so we can use it transparently
+    ### throughout the program
+    my $fh;
+    {   ### reading magic only makes sense if we're opening a file for
+        ### reading. otherwise, just use what the user requested.
+        my $magic = '';
+        if( MODE_READ->($mode) ) {
+            open my $tmp, $file or do {
+                $self->_error( qq[Could not open '$file' for reading: $!] );
+                return;
+            };
+        
+            ### read the first 4 bites of the file to figure out which class to
+            ### use to open the file.
+            sysread( $tmp, $magic, 4 );    
+            close $tmp;
+        }
 
-    } else {
-        if( $gzip ) {
-            $self->_error(qq[Compression not available - Install IO::Zlib!]);
-            return;
+        ### is it bzip?
+        ### if you asked specifically for bzip compression, or if we're in
+        ### read mode and the magic numbers add up, use bzip
+        if( BZIP and (
+                ($compress eq COMPRESS_BZIP) or 
+                ( MODE_READ->($mode) and $magic =~ BZIP_MAGIC_NUM )
+            )
+        ) {
+        
+            ### different reader/writer modules, different error vars... sigh
+            if( MODE_READ->($mode) ) {
+                $fh = IO::Uncompress::Bunzip2->new( $file ) or do {
+                    $self->_error( qq[Could not read '$file': ] .
+                        $IO::Uncompress::Bunzip2::Bunzip2Error
+                    );
+                    return;
+                };
+            
+            } else {
+                $fh = IO::Compress::Bzip2->new( $file ) or do {
+                    $self->_error( qq[Could not write to '$file': ] .
+                        $IO::Compress::Bzip2::Bzip2Error
+                    );
+                    return;
+                };
+            }
+            
+        ### is it gzip?
+        ### if you asked for compression, if you wanted to read or the gzip
+        ### magic number is present (redundant with read)
+        } elsif( ZLIB and (
+                    $compress or MODE_READ->($mode) or $magic =~ GZIP_MAGIC_NUM
+                 )        
+        ) {
+            $fh = IO::Zlib->new;
 
+            unless( $fh->open( $file, $mode ) ) {
+                $self->_error(qq[Could not create filehandle for '$file': $!]);
+                return;
+            }
+            
+        ### is it plain tar?
         } else {
-            $fh = new IO::File;
-            $bin++;
-        }
-    }
+            $fh = IO::File->new;
 
-    unless( $fh->open( $file, $mode ) ) {
-        $self->_error( qq[Could not create filehandle for '$file': $!!] );
-        return;
-    }
+            unless( $fh->open( $file, $mode ) ) {
+                $self->_error(qq[Could not create filehandle for '$file': $!]);
+                return;
+            }
 
-    binmode $fh if $bin;
+            ### enable bin mode on tar archives
+            binmode $fh;
+        }            
+    }
 
     return $fh;
 }
 
+
 sub _read_tar {
     my $self    = shift;
     my $handle  = shift or return;
     my $opts    = shift || {};
 
     my $count   = $opts->{limit}    || 0;
+    my $filter  = $opts->{filter};
     my $extract = $opts->{extract}  || 0;
 
     ### set a cap on the amount of files to extract ###
@@ -372,6 +434,17 @@ sub _read_tar {
             undef $real_name;
         }
 
+        ### skip this entry if we're filtering
+        if ($filter && $entry->name !~ $filter) {
+            next LOOP;
+        
+        ### skip this entry if it's a pax header. This is a special file added
+        ### by, among others, git-generated tarballs. It holds comments and is
+        ### not meant for extracting. See #38932: pax_global_header extracted 
+        } elsif ( $entry->name eq PAX_HEADER ) {
+            next LOOP;
+        }
+        
         $self->_extract_file( $entry ) if $extract
                                             && !$entry->is_longlink
                                             && !$entry->is_unknown
@@ -544,7 +617,7 @@ sub _extract_file {
 
     my $dir;
     ### is $name an absolute path? ###
-    if( File::Spec->file_name_is_absolute( $dirs ) ) {
+    if( $vol || File::Spec->file_name_is_absolute( $dirs ) ) {
 
         ### absolute names are not allowed to be in tarballs under
         ### strict mode, so only allow it if a user tells us to do it
@@ -557,30 +630,65 @@ sub _extract_file {
         }
         
         ### user asked us to, it's fine.
-        $dir = $dirs;
+        $dir = File::Spec->catpath( $vol, $dirs, "" );
 
     ### it's a relative path ###
     } else {
-        my $cwd     = (defined $self->{cwd} ? $self->{cwd} : cwd());
+        my $cwd     = (ref $self and defined $self->{cwd}) 
+                        ? $self->{cwd} 
+                        : cwd();
 
         my @dirs = defined $alt
             ? File::Spec->splitdir( $dirs )         # It's a local-OS path
             : File::Spec::Unix->splitdir( $dirs );  # it's UNIX-style, likely
                                                     # straight from the tarball
 
-        ### paths that leave the current directory are not allowed under
-        ### strict mode, so only allow it if a user tells us to do this.
         if( not defined $alt            and 
-            not $INSECURE_EXTRACT_MODE  and 
-            grep { $_ eq '..' } @dirs
-        ) {
-            $self->_error(
-                q[Entry ']. $entry->full_path .q[' is attempting to leave the ].
-                q[current working directory. Not extracting under SECURE ].
-                q[EXTRACT MODE]
-            );
-            return;
-        }            
+            not $INSECURE_EXTRACT_MODE 
+        ) {            
+
+            ### paths that leave the current directory are not allowed under
+            ### strict mode, so only allow it if a user tells us to do this.
+            if( grep { $_ eq '..' } @dirs ) {
+    
+                $self->_error(
+                    q[Entry ']. $entry->full_path .q[' is attempting to leave ].
+                    q[the current working directory. Not extracting under ].
+                    q[SECURE EXTRACT MODE]
+                );
+                return;
+            } 
+        
+            ### the archive may be asking us to extract into a symlink. This
+            ### is not sane and a possible security issue, as outlined here:
+            ### https://rt.cpan.org/Ticket/Display.html?id=30380
+            ### https://bugzilla.redhat.com/show_bug.cgi?id=295021
+            ### https://issues.rpath.com/browse/RPL-1716
+            my $full_path = $cwd;
+            for my $d ( @dirs ) {
+                $full_path = File::Spec->catdir( $full_path, $d );
+                
+                ### we've already checked this one, and it's safe. Move on.
+                next if ref $self and $self->{_link_cache}->{$full_path};
+
+                if( -l $full_path ) {
+                    my $to   = readlink $full_path;
+                    my $diag = "symlinked directory ($full_path => $to)";
+
+                    $self->_error(
+                        q[Entry ']. $entry->full_path .q[' is attempting to ].
+                        qq[extract to a $diag. This is considered a security ].
+                        q[vulnerability and not allowed under SECURE EXTRACT ].
+                        q[MODE]
+                    );
+                    return;
+                }
+                
+                ### XXX keep a cache if possible, so the stats become cheaper:
+                $self->{_link_cache}->{$full_path} = 1 if ref $self;
+            }
+        }
+
         
         ### '.' is the directory delimiter, of which the first one has to
         ### be escaped/changed.
@@ -622,7 +730,8 @@ sub _extract_file {
     unless ( -d _ ) {
         eval { File::Path::mkpath( $dir, 0, 0777 ) };
         if( $@ ) {
-            $self->_error( qq[Could not create directory '$dir': $@] );
+            my $fp = $entry->full_path;
+            $self->_error(qq[Could not create directory '$dir' for '$fp': $@]);
             return;
         }
         
@@ -672,8 +781,13 @@ sub _extract_file {
         $self->_make_special_file( $entry, $full ) or return;
     }
 
-    utime time, $entry->mtime - TIME_OFFSET, $full or
-        $self->_error( qq[Could not update timestamp] );
+    ### only update the timestamp if it's not a symlink; that will change the
+    ### timestamp of the original. This addresses bug #33669: Could not update
+    ### timestamp warning on symlinks
+    if( not -l $full ) {
+        utime time, $entry->mtime - TIME_OFFSET, $full or
+            $self->_error( qq[Could not update timestamp] );
+    }
 
     if( $CHOWN && CAN_CHOWN ) {
         chown $entry->uid, $entry->gid, $full or
@@ -707,8 +821,8 @@ sub _make_special_file {
                 or $fail++;
         }
 
-        $err =  qq[Making symbolink link from '] . $entry->linkname .
-                qq[' to '$file' failed] if $fail;
+        $err =  qq[Making symbolic link '$file' to '] .
+                $entry->linkname .q[' failed] if $fail;
 
     } elsif ( $entry->is_hardlink ) {
         my $fail;
@@ -949,17 +1063,23 @@ sub clear {
 
 Write the in-memory archive to disk.  The first argument can either
 be the name of a file or a reference to an already open filehandle (a
-GLOB reference). If the second argument is true, the module will use
-IO::Zlib to write the file in a compressed format.  If IO::Zlib is
-not available, the C<write> method will fail and return.
+GLOB reference). 
+
+The second argument is used to indicate compression. You can either 
+compress using C<gzip> or C<bzip2>. If you pass a digit, it's assumed
+to be the C<gzip> compression level (between 1 and 9), but the use of 
+constants is prefered:
+
+  # write a gzip compressed file
+  $tar->write( 'out.tgz', COMPRESSION_GZIP );
+
+  # write a bzip compressed file  
+  $tar->write( 'out.tbz', COMPRESSION_BZIP );
 
 Note that when you pass in a filehandle, the compression argument
 is ignored, as all files are printed verbatim to your filehandle.
 If you wish to enable compression with filehandles, use an
-C<IO::Zlib> filehandle instead.
-
-Specific levels of compression can be chosen by passing the values 2
-through 9 as the second parameter.
+C<IO::Zlib> or C<IO::Compress::Bzip2> filehandle instead.
 
 The third argument is an optional prefix. All files will be tucked
 away in the directory you specify as prefix. So if you have files
@@ -970,6 +1090,7 @@ If no arguments are given, C<write> returns the entire formatted
 archive as a string, which could be useful if you'd like to stuff the
 archive into a socket or a pipe to gzip or something.
 
+
 =cut
 
 sub write {
@@ -1383,23 +1504,27 @@ sub has_perlio { return $HAS_PERLIO; }
 
 =head1 Class Methods
 
-=head2 Archive::Tar->create_archive($file, $compression, @filelist)
+=head2 Archive::Tar->create_archive($file, $compressed, @filelist)
 
 Creates a tar file from the list of files provided.  The first
 argument can either be the name of the tar file to create or a
 reference to an open file handle (e.g. a GLOB reference).
 
-The second argument specifies the level of compression to be used, if
-any.  Compression of tar files requires the installation of the
-IO::Zlib module.  Specific levels of compression may be
-requested by passing a value between 2 and 9 as the second argument.
-Any other value evaluating as true will result in the default
-compression level being used.
+The second argument is used to indicate compression. You can either 
+compress using C<gzip> or C<bzip2>. If you pass a digit, it's assumed
+to be the C<gzip> compression level (between 1 and 9), but the use of 
+constants is prefered:
+
+  # write a gzip compressed file
+  Archive::Tar->create_archive( 'out.tgz', COMPRESSION_GZIP, @filelist );
+
+  # write a bzip compressed file  
+  Archive::Tar->create_archive( 'out.tbz', COMPRESSION_BZIP, @filelist );
 
 Note that when you pass in a filehandle, the compression argument
 is ignored, as all files are printed verbatim to your filehandle.
 If you wish to enable compression with filehandles, use an
-C<IO::Zlib> filehandle instead.
+C<IO::Zlib> or C<IO::Compress::Bzip2> filehandle instead.
 
 The remaining arguments list the files to be included in the tar file.
 These files must all exist. Any files which don't exist or can't be
@@ -1431,7 +1556,63 @@ sub create_archive {
     return $tar->write( $file, $gzip );
 }
 
-=head2 Archive::Tar->list_archive ($file, $compressed, [\@properties])
+=head2 Archive::Tar->iter( $filename, [ $compressed, {opt => $val} ] )
+
+Returns an iterator function that reads the tar file without loading
+it all in memory.  Each time the function is called it will return the
+next file in the tarball. The files are returned as
+C<Archive::Tar::File> objects. The iterator function returns the
+empty list once it has exhausted the the files contained.
+
+The second argument can be a hash reference with options, which are
+identical to the arguments passed to C<read()>.
+
+Example usage:
+
+    my $next = Archive::Tar->iter( "example.tar.gz", 1, {filter => qr/\.pm$/} );
+
+    while( my $f = $next->() ) {
+        print $f->name, "\n";
+
+        $f->extract or warn "Extraction failed";
+        
+        # ....
+    }
+
+=cut
+
+
+sub iter {
+    my $class       = shift;
+    my $filename    = shift or return;
+    my $compressed  = shift or 0;
+    my $opts        = shift || {};
+
+    ### get a handle to read from.
+    my $handle = $class->_get_handle(
+        $filename, 
+        $compressed, 
+        READ_ONLY->( ZLIB )
+    ) or return;
+
+    my @data;
+    return sub {
+        return shift(@data)     if @data;       # more than one file returned?
+        return                  unless $handle; # handle exhausted?
+
+        ### read data, should only return file
+        @data = @{ $class->_read_tar($handle, { %$opts, limit => 1 }) };
+
+        ### return one piece of data
+        return shift(@data)     if @data;
+        
+        ### data is exhausted, free the filehandle
+        undef $handle;
+        return;
+    };
+}
+
+=head2 Archive::Tar->list_archive($file, $compressed, [\@properties])
 
 Returns a list of the names of all the files in the archive.  The
 first argument can either be the name of the tar file to list or a
@@ -1462,7 +1643,7 @@ sub list_archive {
     return $tar->list_files( @_ );
 }
 
-=head2 Archive::Tar->extract_archive ($file, $gzip)
+=head2 Archive::Tar->extract_archive($file, $compressed)
 
 Extracts the contents of the tar file.  The first argument can either
 be the name of the tar file to create or a reference to an open file
@@ -1489,8 +1670,8 @@ sub extract_archive {
 =head2 Archive::Tar->can_handle_compressed_files
 
 A simple checking routine, which will return true if C<Archive::Tar>
-is able to uncompress compressed archives on the fly with C<IO::Zlib>,
-or false if C<IO::Zlib> is not installed.
+is able to uncompress compressed archives on the fly with C<IO::Zlib>
+and C<IO::Compress::Bzip2> or false if not both are installed.
 
 You can use this as a shortcut to determine whether C<Archive::Tar>
 will do what you think before passing compressed archives to its
@@ -1498,7 +1679,7 @@ C<read> method.
 
 =cut
 
-sub can_handle_compressed_files { return ZLIB ? 1 : 0 }
+sub can_handle_compressed_files { return ZLIB && BZIP ? 1 : 0 }
 
 sub no_string_support {
     croak("You have to install IO::String to support writing archives to strings");
@@ -1645,18 +1826,24 @@ Yes it is, see previous answer. Since C<Compress::Zlib> and therefore
 C<IO::Zlib> doesn't support C<seek> on their filehandles, there is little
 choice but to read the archive into memory.
 This is ok if you want to do in-memory manipulation of the archive.
+
 If you just want to extract, use the C<extract_archive> class method
 instead. It will optimize and write to disk immediately.
 
-=item Can't you lazy-load data instead?
+Another option is to use the C<iter> class method to iterate over
+the files in the tarball without reading them all in memory at once.
+
+=item Can you lazy-load data instead?
 
-No, not easily. See previous question.
+In some cases, yes. You can use the C<iter> class method to iterate
+over the files in the tarball without reading them all in memory at once.
 
 =item How much memory will an X kb tar file need?
 
 Probably more than X kb, since it will all be read into memory. If
 this is a problem, and you don't need to do in memory manipulation
-of the archive, consider using C</bin/tar> instead.
+of the archive, consider using the C<iter> class method, or C</bin/tar> 
+instead.
 
 =item What do you do with unsupported filetypes in an archive?
 
@@ -1666,8 +1853,9 @@ try to make a copy of the original file, rather than throwing an error.
 
 This does require you to read the entire archive in to memory first,
 since otherwise we wouldn't know what data to fill the copy with.
-(This means that you cannot use the class methods on archives that
-have incompatible filetypes and still expect things to work).
+(This means that you cannot use the class methods, including C<iter> 
+on archives that 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.
@@ -1852,8 +2040,8 @@ Please reports bugs to E<lt>bug-archive-tar@rt.cpan.orgE<gt>.
 
 =head1 ACKNOWLEDGEMENTS
 
-Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney and
-especially Andrew Savige for their help and suggestions.
+Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney, Gisle Aas
+and especially Andrew Savige for their help and suggestions.
 
 =head1 COPYRIGHT
 
index 00416d5..699d985 100644 (file)
@@ -2,20 +2,16 @@ package Archive::Tar::Constant;
 
 BEGIN {
     require Exporter;
-    $VERSION= '0.02';
-    @ISA    = qw[Exporter];
-    @EXPORT = qw[
-                FILE HARDLINK SYMLINK CHARDEV BLOCKDEV DIR FIFO SOCKET UNKNOWN
-                BUFFER HEAD READ_ONLY WRITE_ONLY UNPACK PACK TIME_OFFSET ZLIB
-                BLOCK_SIZE TAR_PAD TAR_END ON_UNIX BLOCK CAN_READLINK MAGIC 
-                TAR_VERSION UNAME GNAME CAN_CHOWN MODE CHECK_SUM UID GID 
-                GZIP_MAGIC_NUM MODE_READ LONGLINK LONGLINK_NAME PREFIX_LENGTH
-                LABEL NAME_LENGTH STRIP_MODE ON_VMS
-            ];
+    
+    $VERSION    = '0.02';
+    @ISA        = qw[Exporter];
 
     require Time::Local if $^O eq "MacOS";
 }
 
+use Package::Constants;
+@EXPORT = Package::Constants->list( __PACKAGE__ );
+
 use constant FILE           => 0;
 use constant HARDLINK       => 1;
 use constant SYMLINK        => 2;
@@ -32,6 +28,9 @@ use constant BUFFER         => 4096;
 use constant HEAD           => 512;
 use constant BLOCK          => 512;
 
+use constant COMPRESS_GZIP  => 9;
+use constant COMPRESS_BZIP  => 'bzip2';
+
 use constant BLOCK_SIZE     => sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK };
 use constant TAR_PAD        => sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) };
 use constant TAR_END        => "\0" x BLOCK;
@@ -61,14 +60,23 @@ use constant TIME_OFFSET    => ($^O eq "MacOS") ? Time::Local::timelocal(0,0,0,1
 use constant MAGIC          => "ustar";
 use constant TAR_VERSION    => "00";
 use constant LONGLINK_NAME  => '././@LongLink';
+use constant PAX_HEADER     => 'pax_global_header';
 
-                            ### allow ZLIB to be turned off using ENV
-                            ### DEBUG only
+                            ### 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 };
-                                    
+                                    $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 
+                                };
+
+                            ### allow BZIP to be turned off using ENV: DEBUG only                                
+use constant BZIP           => do { !$ENV{'PERL5_AT_NO_BZIP'} and
+                                        eval { require IO::Uncompress::Bunzip2;
+                                               require IO::Compress::Bzip2; };
+                                    $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1 
+                                };
+
 use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/;
+use constant BZIP_MAGIC_NUM => qr/^BZh\d/;
 
 use constant CAN_CHOWN      => do { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
 use constant CAN_READLINK   => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
index 8c96577..d5c2fee 100644 (file)
@@ -1,15 +1,18 @@
 package Archive::Tar::File;
 use strict;
 
+use Carp                ();
 use IO::File;
 use File::Spec::Unix    ();
 use File::Spec          ();
 use File::Basename      ();
 
+### avoid circular use, so only require;
+require Archive::Tar;
 use Archive::Tar::Constant;
 
 use vars qw[@ISA $VERSION];
-@ISA        = qw[Archive::Tar];
+#@ISA        = qw[Archive::Tar];
 $VERSION    = '0.02';
 
 ### set value to 1 to oct() it during the unpack ###
@@ -154,13 +157,13 @@ Raw tar header -- not useful for most users
 
 =head1 Methods
 
-=head2 new( file => $path )
+=head2 Archive::Tar::File->new( file => $path )
 
 Returns a new Archive::Tar::File object from an existing file.
 
 Returns undef on failure.
 
-=head2 new( data => $path, $data, $opt )
+=head2 Archive::Tar::File->new( data => $path, $data, $opt )
 
 Returns a new Archive::Tar::File object from data.
 
@@ -171,7 +174,7 @@ tar header), which are described above in the Accessors section.
 
 Returns undef on failure.
 
-=head2 new( chunk => $chunk )
+=head2 Archive::Tar::File->new( chunk => $chunk )
 
 Returns a new Archive::Tar::File object from a raw 512-byte tar
 archive chunk.
@@ -266,6 +269,29 @@ sub _new_from_file {
     my @items       = qw[mode uid gid size mtime];
     my %hash        = map { shift(@items), $_ } (lstat $path)[2,4,5,7,9];
 
+    if (ON_VMS) {
+        ### VMS has two UID modes, traditional and POSIX.  Normally POSIX is
+        ### not used.  We currently do not have an easy way to see if we are in
+        ### POSIX mode.  In traditional mode, the UID is actually the VMS UIC.
+        ### The VMS UIC has the upper 16 bits is the GID, which in many cases
+        ### the VMS UIC will be larger than 209715, the largest that TAR can
+        ### handle.  So for now, assume it is traditional if the UID is larger
+        ### than 0x10000.
+
+        if ($hash{uid} > 0x10000) {
+            $hash{uid} = $hash{uid} & 0xFFFF;
+        }
+
+        ### The file length from stat() is the physical length of the file
+        ### However the amount of data read in may be more for some file types.
+        ### Fixed length files are read past the logical EOF to end of the block
+        ### containing.  Other file types get expanded on read because record
+        ### delimiters are added.
+
+        my $data_len = length $data;
+        $hash{size} = $data_len if $hash{size} < $data_len;
+
+    }
     ### you *must* set size == 0 on symlinks, or the next entry will be
     ### though of as the contents of the symlink, which is wrong.
     ### this fixes bug #7937
@@ -411,7 +437,25 @@ sub _downgrade_to_plainfile {
     return 1;
 }
 
-=head2 full_path
+=head2 $bool = $file->extract( [ $alternative_name ] )
+
+Extract this object, optionally to an alternative name. 
+
+See C<< Archive::Tar->extract_file >> for details.
+
+Returns true on success and false on failure.
+
+=cut
+
+sub extract {
+    my $self = shift;
+    
+    local $Carp::CarpLevel += 1;
+    
+    return Archive::Tar->_extract_file( $self, @_ );
+}
+
+=head2 $path = $file->full_path
 
 Returns the full path from the tar header; this is basically a
 concatenation of the C<prefix> and C<name> fields.
@@ -429,7 +473,7 @@ sub full_path {
 }
 
 
-=head2 validate
+=head2 $bool = $file->validate
 
 Done by Archive::Tar internally when reading the tar file:
 validate the header against the checksum to ensure integer tar file.
@@ -448,7 +492,7 @@ sub validate {
        return unpack ("%16C*", $raw) == $self->chksum ? 1 : 0;
 }
 
-=head2 has_content
+=head2 $bool = $file->has_content
 
 Returns a boolean to indicate whether the current object has content.
 Some special files like directories and so on never will have any
@@ -462,7 +506,7 @@ sub has_content {
     return defined $self->data() && length $self->data() ? 1 : 0;
 }
 
-=head2 get_content
+=head2 $content = $file->get_content
 
 Returns the current content for the in-memory file
 
@@ -473,7 +517,7 @@ sub get_content {
     $self->data( );
 }
 
-=head2 get_content_by_ref
+=head2 $cref = $file->get_content_by_ref
 
 Returns the current content for the in-memory file as a scalar
 reference. Normal users won't need this, but it will save memory if
@@ -489,7 +533,7 @@ sub get_content_by_ref {
     return \$self->{data};
 }
 
-=head2 replace_content( $content )
+=head2 $bool = $file->replace_content( $content )
 
 Replace the current content of the file with the new content. This
 only affects the in-memory archive, not the on-disk version until
@@ -508,7 +552,7 @@ sub replace_content {
     return 1;
 }
 
-=head2 rename( $new_name )
+=head2 $bool = $file->rename( $new_name )
 
 Rename the current file to $new_name.
 
@@ -540,49 +584,49 @@ use the following methods:
 
 =over 4
 
-=item is_file
+=item $file->is_file
 
 Returns true if the file is of type C<file>
 
-=item is_dir
+=item $file->is_dir
 
 Returns true if the file is of type C<dir>
 
-=item is_hardlink
+=item $file->is_hardlink
 
 Returns true if the file is of type C<hardlink>
 
-=item is_symlink
+=item $file->is_symlink
 
 Returns true if the file is of type C<symlink>
 
-=item is_chardev
+=item $file->is_chardev
 
 Returns true if the file is of type C<chardev>
 
-=item is_blockdev
+=item $file->is_blockdev
 
 Returns true if the file is of type C<blockdev>
 
-=item is_fifo
+=item $file->is_fifo
 
 Returns true if the file is of type C<fifo>
 
-=item is_socket
+=item $file->is_socket
 
 Returns true if the file is of type C<socket>
 
-=item is_longlink
+=item $file->is_longlink
 
 Returns true if the file is of type C<LongLink>.
 Should not happen after a successful C<read>.
 
-=item is_label
+=item $file->is_label
 
 Returns true if the file is of type C<Label>.
 Should not happen after a successful C<read>.
 
-=item is_unknown
+=item $file->is_unknown
 
 Returns true if the file type is C<unknown>
 
index 9b2901b..6a3c1bc 100644 (file)
@@ -1,12 +1,13 @@
 #!/usr/bin/perl
 use strict;
 
+use File::Find;
 use Getopt::Std;
 use Archive::Tar;
-use File::Find;
+use Data::Dumper;
 
 my $opts = {};
-getopts('dcvzthxf:I', $opts) or die usage();
+getopts('Ddcvzthxf:I', $opts) or die usage();
 
 ### show the help message ###
 die usage() if $opts->{h};
@@ -33,72 +34,63 @@ if( $opts->{c} ) {
     find( sub { push @files, $File::Find::name;
                 print $File::Find::name.$/ if $verbose }, @ARGV );
 
-    Archive::Tar->create_archive( $file, $compress, @files );
-    exit;
-}
-
-my $tar = Archive::Tar->new($file, $compress);
+    if ($file eq '-') {
+        use IO::Handle;
+        $file = IO::Handle->new();
+        $file->fdopen(fileno(STDOUT),"w");
+    }
 
-if( $opts->{t} ) {
-    print map { $_->full_path . $/ } $tar->get_files;
+    Archive::Tar->create_archive( $file, $compress, @files );
 
-} elsif( $opts->{x} ) {
-    print map { $_->full_path . $/ } $tar->get_files
-        if $verbose;
-    Archive::Tar->extract_archive($file, $compress);
+} else {
+    if ($file eq '-') {
+        use IO::Handle;
+        $file = IO::Handle->new();
+        $file->fdopen(fileno(STDIN),"r");
+    }
+
+    ### print the files we're finding?
+    my $print = $verbose || $opts->{'t'} || 0;
+
+    my $iter = Archive::Tar->iter( $file );
+        
+    while( my $f = $iter->() ) {
+        print $f->full_path . $/ if $print;
+
+        ### data dumper output
+        print Dumper( $f ) if $opts->{'D'};
+        
+        ### extract it
+        $f->extract if $opts->{'x'};
+    }
 }
 
-
-
+### pod & usage in one
 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]
-        ptar -h
-
-    ptar is a small, tar look-alike program that uses the perl module
-    Archive::Tar to extract, create and list tar archives.
-
-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
-    I   Enable 'Insecure Extract Mode', which allows archives to extract
-        files outside the current working directory. (Not advised).
-
-See Also:
-    tar(1)
-    Archive::Tar
-
-    \n]
-}
+    my $usage .= << '=cut';
+=pod
 
 =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
 
-    ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
-    ptar -x [-v] [-z] [-f ARCHIVE_FILE]
-    ptar -t [-z] [-f ARCHIVE_FILE]
+    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
+    c   Create ARCHIVE_FILE or STDOUT (-) from FILE
+    x   Extract from ARCHIVE_FILE or STDIN (-)
+    t   List the contents of ARCHIVE_FILE or STDIN (-)
     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
@@ -106,6 +98,17 @@ Archive::Tar to extract, create and list tar archives.
 
 =head1 SEE ALSO
 
-tar(1), L<Archive::Tar>.
+    tar(1), L<Archive::Tar>.
 
 =cut
+
+    ### strip the pod directives
+    $usage =~ s/=pod\n//g;
+    $usage =~ s/=head1 //g;
+    
+    ### add some newlines
+    $usage .= $/.$/;
+    
+    return $usage;
+}
+
index 0f13b3c..636760f 100644 (file)
@@ -74,6 +74,9 @@ if ($TOO_LONG) {
 my @ROOT        = grep { length }   'src', $TOO_LONG ? 'short' : 'long';
 
 my $ZLIB        = eval { require IO::Zlib; 1 } ? 1 : 0;
+my $BZIP        = eval { require IO::Uncompress::Bunzip2;
+                         require IO::Compress::Bzip2; 1 } ? 1 : 0;
+
 my $NO_UNLINK   = $ARGV[0] ? 1 : 0;
 
 ### enable debugging?
@@ -86,8 +89,10 @@ my $TARX        = Archive::Tar->new;
 ### paths to a .tar and .tgz file to use for tests
 my $TAR_FILE        = File::Spec->catfile( @ROOT, 'bar.tar' );
 my $TGZ_FILE        = File::Spec->catfile( @ROOT, 'foo.tgz' );
+my $TBZ_FILE        = File::Spec->catfile( @ROOT, 'foo.tbz' );
 my $OUT_TAR_FILE    = File::Spec->catfile( @ROOT, 'out.tar' );
 my $OUT_TGZ_FILE    = File::Spec->catfile( @ROOT, 'out.tgz' );
+my $OUT_TBZ_FILE    = File::Spec->catfile( @ROOT, 'out.tbz' );
 
 my $COMPRESS_FILE = 'copy';
 $^O eq 'VMS' and $COMPRESS_FILE .= '.';
@@ -149,82 +154,70 @@ chmod 0644, $COMPRESS_FILE;
 }
 
 ### read tests ###
-{   ### normal tar + gz compressed file
-    my $archive         = $TAR_FILE;
-    my $compressed      = $TGZ_FILE;
-    my $tar             = Archive::Tar->new;
-    my $gzip            = 0;
-
-    ### check we got the object
-    ok( $tar,                       "Object created" );
-    isa_ok( $tar,                   'Archive::Tar');
-
-    for my $type( $archive, $compressed ) {
-        my $state = $gzip ? 'compressed' : 'uncompressed';
-
-        SKIP: {
+{   my @to_try = ($TAR_FILE);
+    push @to_try, $TGZ_FILE if $ZLIB;
+    push @to_try, $TBZ_FILE if $BZIP;
 
-            ### skip gz compressed archives wihtout IO::Zlib
-            skip(   "No IO::Zlib - cannot read compressed archives",
-                    4 + 2 * (scalar @EXPECT_NORMAL)
-            ) if( $gzip and !$ZLIB);
+    for my $type( @to_try ) {
 
-            ### ->read test
-            {   my @list    = $tar->read( $type );
-                my $cnt     = scalar @list;
-                my $expect  = scalar __PACKAGE__->get_expect();
+        ### normal tar + gz compressed file
+        my $tar             = Archive::Tar->new;
 
-                ok( $cnt,           "Reading $state file using 'read()'" );
-                is( $cnt, $expect,  "   All files accounted for" );
-
-                for my $file ( @list ) {
-                    ok( $file,      "Got File object" );
-                    isa_ok( $file,  "Archive::Tar::File" );
-
-                    ### whitebox test -- make sure find_entry gets the
-                    ### right files
-                    for my $test ( $file->full_path, $file ) {
-                        is( $tar->_find_entry( $test ), $file,
-                                    "   Found proper object" );
-                    }
-                    
-                    next unless $file->is_file;
+        ### check we got the object
+        ok( $tar,                       "Object created" );
+        isa_ok( $tar,                   'Archive::Tar');
+
+        ### ->read test
+        my @list    = $tar->read( $type );
+        my $cnt     = scalar @list;
+        my $expect  = scalar __PACKAGE__->get_expect();
+
+        ok( $cnt,           "Reading '$type' using 'read()'" );
+        is( $cnt, $expect,  "   All files accounted for" );
+
+        for my $file ( @list ) {
+            ok( $file,      "Got File object" );
+            isa_ok( $file,  "Archive::Tar::File" );
+
+            ### whitebox test -- make sure find_entry gets the
+            ### right files
+            for my $test ( $file->full_path, $file ) {
+                is( $tar->_find_entry( $test ), $file,
+                            "   Found proper object" );
+            }
+            
+            next unless $file->is_file;
 
-                    my $name = $file->full_path;
-                    my($expect_name, $expect_content) =
-                        get_expect_name_and_contents( $name, \@EXPECT_NORMAL );
+            my $name = $file->full_path;
+            my($expect_name, $expect_content) =
+                get_expect_name_and_contents( $name, \@EXPECT_NORMAL );
 
-                    ### ->fullname!
-                    ok($expect_name,"   Found expected file '$name'" );
+            ### ->fullname!
+            ok($expect_name,"   Found expected file '$name'" );
 
-                    like($tar->get_content($name), $expect_content,
-                                    "   Content OK" );
-                }
-            }
+            like($tar->get_content($name), $expect_content,
+                            "   Content OK" );
+        }
 
 
-            ### list_archive test
-            {   my @list    = Archive::Tar->list_archive( $archive );
-                my $cnt     = scalar @list;
-                my $expect  = scalar __PACKAGE__->get_expect();
+        ### list_archive test
+        {   my @list    = Archive::Tar->list_archive( $type );
+            my $cnt     = scalar @list;
+            my $expect  = scalar __PACKAGE__->get_expect();
 
-                ok( $cnt,           "Reading $state file using 'list_archive'");
-                is( $cnt, $expect,  "   All files accounted for" );
+            ok( $cnt,           "Reading '$type' using 'list_archive'");
+            is( $cnt, $expect,  "   All files accounted for" );
 
-                for my $file ( @list ) {
-                    next if __PACKAGE__->is_dir( $file ); # directories
+            for my $file ( @list ) {
+                next if __PACKAGE__->is_dir( $file ); # directories
 
-                    my($expect_name, $expect_content) =
-                        get_expect_name_and_contents( $file, \@EXPECT_NORMAL );
+                my($expect_name, $expect_content) =
+                    get_expect_name_and_contents( $file, \@EXPECT_NORMAL );
 
-                    ok( $expect_name,
-                                    "   Found expected file '$file'" );
-                }
+                ok( $expect_name,
+                                "   Found expected file '$file'" );
             }
         }
-
-        ### now we try gz compressed archives
-        $gzip++;
     }
 }
 
@@ -433,28 +426,19 @@ SKIP: {
         }
 
         ## write tgz tests
-        {   my $out = $OUT_TGZ_FILE;
-
-            SKIP: {
-
-                ### weird errors from scalar(@x,@y,@z), dot it this way...
-                my $file_cnt;
-                map { $file_cnt += scalar @$_ } \@EXPECT_NORMAL, \@EXPECTBIN,
-                                                \@EXPECTX;
-
-                my $cnt =   5 +                 # the tests below
-                            (5*3*2) +           # check_tgz_file
-                                                # check_tar_object fixed tests
-                            (3 * 2 * (2 + $file_cnt)) +
-                            ((4*$file_cnt) + 1);# check_tar_extract tests
+        {   my @out;
+            push @out, [ $OUT_TGZ_FILE => 1             ] if $ZLIB;
+            push @out, [ $OUT_TBZ_FILE => COMPRESS_BZIP ] if $BZIP;
+        
+            for my $entry ( @out ) {
 
-                skip( "No IO::Zlib - cannot write compressed archives", $cnt )
-                    unless $ZLIB;
+                my( $out, $compression ) = @$entry;
 
                 {   ### write()
-                    ok($obj->write($out, 1),
-                                    "Writing compressed file using 'write'" );
-                    check_tgz_file( $out );
+                    ok($obj->write($out, $compression),
+                                    "Writing compressed file '$out' using 'write'" );
+                    check_compressed_file( $out );
+
                     check_tar_object( $obj, $struct );
 
                     ### now read it in again
@@ -471,12 +455,12 @@ SKIP: {
                 }
 
                 {   ### create_archive()
-                    ok( Archive::Tar->create_archive( $out, 1, $COMPRESS_FILE ),
-                                    "Wrote gzip file using 'create_archive'" );
-                    check_tgz_file( $out );
+                    ok( Archive::Tar->create_archive( $out, $compression, $COMPRESS_FILE ),
+                                    "Wrote '$out' using 'create_archive'" );
+                    check_compressed_file( $out );
 
                     ### now extract it again
-                    ok( Archive::Tar->extract_archive( $out, 1 ),
+                    ok( Archive::Tar->extract_archive( $out, $compression ),
                                     "Extracted file using 'extract_archive'");
                     rm( $out ) unless $NO_UNLINK;
                 }
@@ -645,10 +629,10 @@ sub check_tar_file {
     return $contents;
 }
 
-sub check_tgz_file {
+sub check_compressed_file {
     my $file                = shift;
     my $filesize            = -s $file;
-    my $contents            = slurp_gzfile( $file );
+    my $contents            = slurp_compressed_file( $file );
     my $uncompressedsize    = length $contents;
 
     ok( defined( $contents ),   "   File read and uncompressed" );
@@ -762,18 +746,29 @@ sub slurp_binfile {
     return <$fh>;
 }
 
-sub slurp_gzfile {
+sub slurp_compressed_file {
     my $file = shift;
-    my $str;
-    my $buff;
+    my $fh;
+    
+    ### bzip2
+    if( $file =~ /.tbz$/ ) {
+        require IO::Uncompress::Bunzip2;
+        $fh = IO::Uncompress::Bunzip2->new( $file )    
+            or warn( "Error opening '$file' with IO::Uncompress::Bunzip2" ), return
 
-    require IO::Zlib;
-    my $fh = new IO::Zlib;
-    $fh->open( $file, READ_ONLY->(1) )
-        or warn( "Error opening '$file' with IO::Zlib" ), return undef;
+    ### gzip
+    } else {
+        require IO::Zlib;
+        $fh = new IO::Zlib;
+        $fh->open( $file, READ_ONLY->(1) )
+            or warn( "Error opening '$file' with IO::Zlib" ), return
+    }        
 
+    my $str;
+    my $buff;
     $str .= $buff while $fh->read( $buff, 4096 ) > 0;
     $fh->close();
+
     return $str;
 }
 
diff --git a/lib/Archive/Tar/t/05_iter.t b/lib/Archive/Tar/t/05_iter.t
new file mode 100644 (file)
index 0000000..cf52eea
--- /dev/null
@@ -0,0 +1,65 @@
+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 $Class   = 'Archive::Tar';
+my $FClass  = 'Archive::Tar::File';
+my $File    = 'src/long/bar.tar';
+my @Expect = (
+    qr|^c$|,
+    qr|^d$|,
+    qr|^directory/$|,
+    qr|^directory/really.*name/$|,
+    qr|^directory/.*/myfile$|,
+);
+
+use_ok( $Class );
+
+### crazy ref to special case 'all'
+for my $index ( \0, 0 .. $#Expect ) {   
+
+    my %opts    = ();
+    my @expect  = ();
+    
+    ### do a full test vs individual filters
+    if( not ref $index ) {
+        my $regex       = $Expect[$index];
+        $opts{'filter'} = $regex;
+        @expect         = ($regex);
+    } else {
+        @expect         = @Expect;
+    }        
+
+    my $next = $Class->iter( $File, 0, \%opts );
+    
+    my $pp_opts = join " => ", %opts;
+    ok( $next,                  "Iterator created from $File ($pp_opts)" );
+    isa_ok( $next, "CODE",      "   Iterator" );
+
+    my @names;
+    while( my $f = $next->() ) {
+        ok( $f,                 "       File object retrieved" );
+        isa_ok( $f, $FClass,    "           Object" );
+
+        push @names, $f->name;
+    }
+    
+    is( scalar(@names), scalar(@expect),
+                                "   Found correct number of files" );
+    
+    my $i = 0;
+    for my $name ( @names ) {
+        ok( 1,                  "   Inspecting '$name' " );
+        like($name, $expect[$i],"       Matches $Expect[$i]" );
+        $i++;
+    }        
+}
diff --git a/lib/Archive/Tar/t/90_symlink.t b/lib/Archive/Tar/t/90_symlink.t
new file mode 100644 (file)
index 0000000..87be3a3
--- /dev/null
@@ -0,0 +1,62 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
+    }       
+    use lib '../../..';
+}
+
+BEGIN { chdir 't' if -d 't' }
+
+use lib '../lib';
+
+use strict;
+use File::Spec;
+use File::Path;
+use Test::More;
+
+### developer tests mostly, so enable them with an extra argument
+plan skip_all => "Skipping tests on this platform" unless @ARGV;
+plan 'no_plan';
+
+my $Class   = 'Archive::Tar';
+my $Dir     = File::Spec->catdir( qw[src linktest] );    
+my %Map     = (
+    File::Spec->catfile( $Dir, "linktest_with_dir.tar" ) => [
+        [ 0, qr/SECURE EXTRACT MODE/ ],
+        [ 1, qr/^$/ ]
+    ],
+    File::Spec->catfile( $Dir, "linktest_missing_dir.tar" ) => [
+        [ 0, qr/SECURE EXTRACT MODE/ ],
+        [ 0, qr/File exists/ ],
+    ],
+);
+
+use_ok( $Class );
+
+{   while( my($file, $aref) = each %Map ) {
+
+        for my $mode ( 0, 1 ) {
+            my $expect = $aref->[$mode]->[0];
+            my $regex  = $aref->[$mode]->[1];
+
+            my $tar  = $Class->new( $file );
+            ok( $tar,                   "Object created from $file" );
+
+            ### damn warnings
+            local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
+            local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
+            
+            ok( 1,                  "   Extracting with insecure mode: $mode" );
+
+            my $warning;
+            local $SIG{__WARN__} = sub { $warning .= "@_"; warn @_; };
+
+            my $rv = eval { $tar->extract } || 0;
+            ok( !$@,                "       No fatal error" );
+            is( !!$rv, !!$expect,   "       RV as expected" );
+            like( $warning, $regex, "       Error matches $regex" );
+    
+            rmtree( 'linktest' );
+        }
+    }        
+}    
diff --git a/lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed b/lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed
new file mode 100644 (file)
index 0000000..24ef956
--- /dev/null
@@ -0,0 +1,243 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+     uupacktool.pl -u linktest_missing_dir.tar.packed linktest_missing_dir.tar
+
+To recreate it use the following command:
+
+     uupacktool.pl -p linktest_missing_dir.tar linktest_missing_dir.tar.packed
+
+Created at Wed Oct  1 17:21:49 2008
+#########################################################################
+__UU__
+M;&EN:W1E<W0O;&EN:P``````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````````````#`P,#`W-34`,#`P,#<V-0`P,#`P,#`P`#`P,#`P,#`P,#`P
+M`#$Q,#4S-34T-S4P`#`Q,S(U,``@,F]R:6<`````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````````````````````````!U<W1A<B`@`&MA;F4`
+M````````````````````````````````````=VAE96P`````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````!L:6YK=&5S="]L:6YK+W@`````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````,#`P,#8T-``P,#`P-S8U`#`P
+M,#`P,#``,#`P,#`P,#`P,#``,3$P-3,U-30W,38`,#$R-C,S`"`P````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````'5S=&%R("``:V%N90````````````````````````````````````!W
+M:&5E;```````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+9````````````````````````````````````
diff --git a/lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed b/lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed
new file mode 100644 (file)
index 0000000..671146e
--- /dev/null
@@ -0,0 +1,232 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+     uupacktool.pl -u linktest_with_dir.tar.packed linktest_with_dir.tar
+
+To recreate it use the following command:
+
+     uupacktool.pl -p linktest_with_dir.tar linktest_with_dir.tar.packed
+
+Created at Wed Oct  1 17:22:07 2008
+#########################################################################
+__UU__
+M;&EN:W1E<W0O;W)I9R\`````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````````````#`P,#`W-34`,#`P,#<V-0`P,#`P,#`P`#`P,#`P,#`P,#`P
+M`#$Q,#4S-34T-S$V`#`Q,C0U-@`@-0``````````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````````````````````````!U<W1A<B`@`&MA;F4`
+M````````````````````````````````````=VAE96P`````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M``````````````````````!L:6YK=&5S="]L:6YK````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````,#`P,#<U-0`P,#`P-S8U`#`P
+M,#`P,#``,#`P,#`P,#`P,#``,3$P-3,U-30W-3``,#$S,C4P`"`R;W)I9P``
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````'5S=&%R("``:V%N90````````````````````````````````````!W
+M:&5E;```````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M`````````````````````````````````````````````&QI;FMT97-T+VQI
+M;FLO>```````````````````````````````````````````````````````
+M```````````````````````````````````````````````````````````P
+M,#`P-C0T`#`P,#`W-C4`,#`P,#`P,``P,#`P,#`P,#`P,``Q,3`U,S4U-#<Q
+M-@`P,3(V,S,`(#``````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````=7-T87(@(`!K86YE````````````````
+M`````````````````````'=H965L````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+)```````````*
diff --git a/lib/Archive/Tar/t/src/long/foo.tbz.packed b/lib/Archive/Tar/t/src/long/foo.tbz.packed
new file mode 100644 (file)
index 0000000..96e9788
--- /dev/null
@@ -0,0 +1,23 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+     uupacktool.pl -u foo.tbz.packed foo.tbz
+
+To recreate it use the following command:
+
+     uupacktool.pl -p foo.tbz foo.tbz.packed
+
+Created at Wed Oct  1 17:23:46 2008
+#########################################################################
+__UU__
+M0EIH.3%!62936=873NT``9C_A._0`DA``_^`0`0)`._OGJ```40(,`%X9`8`
+M::-!IB```!D`)28FI````````(HE,F%3RF3R8FIM/5&F#33(>IZID>"="?4U
+M>/C^S:X'D<2&UOMUE`"-`(N%MQA29*3$)UC1X82:*B,-Q7FMI2DVI<#P6%65
+M/B$/:G=OYT0SKT65Y'T()B;2=WF$2%CLTJ.KTD0;Q.)"/81[2R\B9=]9)23.
+M1F@@IS0Q030J3;>[221,'HFJ3WH0M`Y#.TI(I@%<RH/$AH8>R26=14&*"&"L
+M1PD0,HZH$-!#H2`UEQL.14#Z)L$$^3U2B\,R_?,RZ<_X7)YXG^04Q+R/=,4\
+MK`R+N+%?P?2UFQ+S267E(`$I^B`!)-]"4Y!65-QU&U:BM<X`V$"L%BW%2XIS
+<63('[6F2P:JS\FD@5"$VW*O_%W)%.%"0UA=.[0``
diff --git a/lib/Archive/Tar/t/src/short/foo.tbz.packed b/lib/Archive/Tar/t/src/short/foo.tbz.packed
new file mode 100644 (file)
index 0000000..3e6752d
--- /dev/null
@@ -0,0 +1,19 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+     uupacktool.pl -u foo.tbz.packed foo.tbz
+
+To recreate it use the following command:
+
+     uupacktool.pl -p foo.tbz foo.tbz.packed
+
+Created at Wed Oct  1 17:24:13 2008
+#########################################################################
+__UU__
+M0EIH.3%!62936>GH,8X``)O[A.90`D!``'^```#O*1X```%`""``E(*JGDA#
+M1H#0Q&F@)%1J8C3$Q,T3`U)1(QL-#P5L`'2A)$,<1C&7N<@%XQ(2UAGTYV56
+MM$I>-BHHJN(9*$J286."<%>*U,.3%6B$*2E6R+DH-6B&?[5DZ(J7DG#H_$@<
+/AE%`D'\7<D4X4)#IZ#&.