Add Archive::Tar 1.24, except ptar for now

p4raw-id: //depot/perl@24922

12 files changed, 1587 insertions, 0 deletions

diff --git a/lib/Archive/Tar/Constant.pm b/lib/Archive/Tar/Constant.pm
new file mode 100644
index 0000000000..fe5bb14726
--- /dev/null
+++ b/lib/Archive/Tar/Constant.pm
@@ -0,0 +1,72 @@
+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
+            ];
+
+    require Time::Local if $^O eq "MacOS";
+}
+
+use constant FILE           => 0;
+use constant HARDLINK       => 1;
+use constant SYMLINK        => 2;
+use constant CHARDEV        => 3;
+use constant BLOCKDEV       => 4;
+use constant DIR            => 5;
+use constant FIFO           => 6;
+use constant SOCKET         => 8;
+use constant UNKNOWN        => 9;
+use constant LONGLINK       => 'L';
+use constant LABEL          => 'V';
+
+use constant BUFFER         => 4096;
+use constant HEAD           => 512;
+use constant BLOCK          => 512;
+
+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;
+
+use constant READ_ONLY      => sub { shift() ? 'rb' : 'r' };
+use constant WRITE_ONLY     => sub { $_[0] ? 'wb' . shift : 'w' };
+use constant MODE_READ      => sub { $_[0] =~ /^r/ ? 1 : 0 };
+
+# Pointless assigment to make -w shut up
+my $getpwuid; $getpwuid = 'unknown' unless eval { my $f = getpwuid (0); };
+my $getgrgid; $getgrgid = 'unknown' unless eval { my $f = getgrgid (0); };
+use constant UNAME          => sub { $getpwuid || scalar getpwuid( shift() ) };
+use constant GNAME          => sub { $getgrgid || scalar getgrgid( shift() ) };
+use constant UID            => $>;
+use constant GID            => (split ' ', $) )[0];
+
+use constant MODE           => do { 0666 & (0777 & ~umask) };
+use constant STRIP_MODE     => sub { shift() & 0777 };
+use constant CHECK_SUM      => "      ";
+
+use constant UNPACK         => 'A100 A8 A8 A8 A12 A12 A8 A1 A100 A6 A2 A32 A32 A8 A8 A155 x12';
+use constant PACK           => 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
+use constant NAME_LENGTH    => 100;
+use constant PREFIX_LENGTH  => 155;
+
+use constant TIME_OFFSET    => ($^O eq "MacOS") ? Time::Local::timelocal(0,0,0,1,0,70) : 0;    
+use constant MAGIC          => "ustar";
+use constant TAR_VERSION    => "00";
+use constant LONGLINK_NAME  => '././@LongLink';
+
+use constant ZLIB           => do { eval { require IO::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") };
+use constant CAN_READLINK   => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
+use constant ON_UNIX        => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS');
+
+1;
diff --git a/lib/Archive/Tar/File.pm b/lib/Archive/Tar/File.pm
new file mode 100644
index 0000000000..a310ee9de9
--- /dev/null
+++ b/lib/Archive/Tar/File.pm
@@ -0,0 +1,579 @@
+package Archive::Tar::File;
+use strict;
+
+use IO::File;
+use File::Spec::Unix ();
+use File::Spec ();
+use File::Basename ();
+use Archive::Tar::Constant;
+
+use vars qw[@ISA $VERSION];
+@ISA        = qw[Archive::Tar];
+$VERSION    = '0.02';
+
+### set value to 1 to oct() it during the unpack ###
+my $tmpl = [
+        name        => 0,   # string
+        mode        => 1,   # octal
+        uid         => 1,   # octal
+        gid         => 1,   # octal
+        size        => 1,   # octal
+        mtime       => 1,   # octal
+        chksum      => 1,   # octal
+        type        => 0,   # character
+        linkname    => 0,   # string
+        magic       => 0,   # string
+        version     => 0,   # 2 bytes
+        uname       => 0,   # string
+        gname       => 0,   # string
+        devmajor    => 1,   # octal
+        devminor    => 1,   # octal
+        prefix      => 0,
+
+### end UNPACK items ###
+        raw         => 0,   # the raw data chunk
+        data        => 0,   # the data associated with the file --
+                            # This  might be very memory intensive
+];
+
+### install get/set accessors for this object.
+for ( my $i=0; $i<scalar @$tmpl ; $i+=2 ) {
+    my $key = $tmpl->[$i];
+    no strict 'refs';
+    *{__PACKAGE__."::$key"} = sub {
+        my $self = shift;
+        $self->{$key} = $_[0] if @_;
+
+        ### just in case the key is not there or undef or something ###
+        {   local $^W = 0;
+            return $self->{$key};
+        }
+    }
+}
+
+=head1 NAME
+
+Archive::Tar::File - a subclass for in-memory extracted file from Archive::Tar
+
+=head1 SYNOPSIS
+
+    my @items = $tar->get_files;
+
+    print $_->name, ' ', $_->size, "\n" for @items;
+
+    print $object->get_content;
+    $object->replace_content('new content');
+
+    $object->rename( 'new/full/path/to/file.c' );
+
+=head1 DESCRIPTION
+
+Archive::Tar::Files provides a neat little object layer for in-memory
+extracted files. It's mostly used internally in Archive::Tar to tidy
+up the code, but there's no reason users shouldn't use this API as
+well.
+
+=head2 Accessors
+
+A lot of the methods in this package are accessors to the various
+fields in the tar header:
+
+=over 4
+
+=item name
+
+The file's name
+
+=item mode
+
+The file's mode
+
+=item uid
+
+The user id owning the file
+
+=item gid
+
+The group id owning the file
+
+=item size
+
+File size in bytes
+
+=item mtime
+
+Modification time. Adjusted to mac-time on MacOS if required
+
+=item chksum
+
+Checksum field for the tar header
+
+=item type
+
+File type -- numeric, but comparable to exported constants -- see
+Archive::Tar's documentation
+
+=item linkname
+
+If the file is a symlink, the file it's pointing to
+
+=item magic
+
+Tar magic string -- not useful for most users
+
+=item version
+
+Tar version string -- not useful for most users
+
+=item uname
+
+The user name that owns the file
+
+=item gname
+
+The group name that owns the file
+
+=item devmajor
+
+Device major number in case of a special file
+
+=item devminor
+
+Device minor number in case of a special file
+
+=item prefix
+
+Any directory to prefix to the extraction path, if any
+
+=item raw
+
+Raw tar header -- not useful for most users
+
+=back
+
+=head1 Methods
+
+=head2 new( file => $path )
+
+Returns a new Archive::Tar::File object from an existing file.
+
+Returns undef on failure.
+
+=head2 new( data => $path, $data, $opt )
+
+Returns a new Archive::Tar::File object from data.
+
+C<$path> defines the file name (which need not exist), C<$data> the
+file contents, and C<$opt> is a reference to a hash of attributes
+which may be used to override the default attributes (fields in the
+tar header), which are described above in the Accessors section.
+
+Returns undef on failure.
+
+=head2 new( chunk => $chunk )
+
+Returns a new Archive::Tar::File object from a raw 512-byte tar
+archive chunk.
+
+Returns undef on failure.
+
+=cut
+
+sub new {
+    my $class   = shift;
+    my $what    = shift;
+
+    my $obj =   ($what eq 'chunk') ? __PACKAGE__->_new_from_chunk( @_ ) :
+                ($what eq 'file' ) ? __PACKAGE__->_new_from_file( @_ ) :
+                ($what eq 'data' ) ? __PACKAGE__->_new_from_data( @_ ) :
+                undef;
+
+    return $obj;
+}
+
+### copies the data, creates a clone ###
+sub clone {
+    my $self = shift;
+    return bless { %$self }, ref $self;
+}
+
+sub _new_from_chunk {
+    my $class = shift;
+    my $chunk = shift or return;
+
+    ### makes it start at 0 actually... :) ###
+    my $i = -1;
+    my %entry = map {
+        $tmpl->[++$i] => $tmpl->[++$i] ? oct $_ : $_
+    } map { /^([^\0]*)/ } unpack( UNPACK, $chunk );
+
+    my $obj = bless \%entry, $class;
+
+	### magic is a filetype string.. it should have something like 'ustar' or
+	### something similar... if the chunk is garbage, skip it
+	return unless $obj->magic !~ /\W/;
+
+    ### store the original chunk ###
+    $obj->raw( $chunk );
+
+    $obj->type(FILE) if ( (!length $obj->type) or ($obj->type =~ /\W/) );
+    $obj->type(DIR)  if ( ($obj->is_file) && ($obj->name =~ m|/$|) );
+
+
+    return $obj;
+
+}
+
+sub _new_from_file {
+    my $class       = shift;
+    my $path        = shift or return;
+    my $type        = __PACKAGE__->_filetype($path);
+    my $data        = '';
+
+    unless ($type == DIR) {
+        my $fh = IO::File->new;
+        $fh->open($path) or return;
+
+        ### binmode needed to read files properly on win32 ###
+        binmode $fh;
+        $data = do { local $/; <$fh> };
+        close $fh;
+    }
+
+    my @items       = qw[mode uid gid size mtime];
+    my %hash        = map { shift(@items), $_ } (lstat $path)[2,4,5,7,9];
+
+    ### 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
+    $hash{size}     = 0 if ($type == DIR or $type == SYMLINK);
+    $hash{mtime}    -= TIME_OFFSET;
+
+    ### strip the high bits off the mode, which we don't need to store
+    $hash{mode}     = STRIP_MODE->( $hash{mode} );
+
+
+    ### probably requires some file path munging here ... ###
+    ### name and prefix are set later
+    my $obj = {
+        %hash,
+        name        => '',
+        chksum      => CHECK_SUM,
+        type        => $type,
+        linkname    => ($type == SYMLINK and CAN_READLINK)
+                            ? readlink $path
+                            : '',
+        magic       => MAGIC,
+        version     => TAR_VERSION,
+        uname       => UNAME->( $hash{uid} ),
+        gname       => GNAME->( $hash{gid} ),
+        devmajor    => 0,   # not handled
+        devminor    => 0,   # not handled
+        prefix      => '',
+        data        => $data,
+    };
+
+    bless $obj, $class;
+
+    ### fix up the prefix and file from the path
+    my($prefix,$file) = $obj->_prefix_and_file( $path );
+    $obj->prefix( $prefix );
+    $obj->name( $file );
+
+    return $obj;
+}
+
+sub _new_from_data {
+    my $class   = shift;
+    my $path    = shift     or return;
+    my $data    = shift;    return unless defined $data;
+    my $opt     = shift;
+
+    my $obj = {
+        data        => $data,
+        name        => '',
+        mode        => MODE,
+        uid         => UID,
+        gid         => GID,
+        size        => length $data,
+        mtime       => time - TIME_OFFSET,
+        chksum      => CHECK_SUM,
+        type        => FILE,
+        linkname    => '',
+        magic       => MAGIC,
+        version     => TAR_VERSION,
+        uname       => UNAME->( UID ),
+        gname       => GNAME->( GID ),
+        devminor    => 0,
+        devmajor    => 0,
+        prefix      => '',
+    };
+
+    ### overwrite with user options, if provided ###
+    if( $opt and ref $opt eq 'HASH' ) {
+        for my $key ( keys %$opt ) {
+
+            ### don't write bogus options ###
+            next unless exists $obj->{$key};
+            $obj->{$key} = $opt->{$key};
+        }
+    }
+
+    bless $obj, $class;
+
+    ### fix up the prefix and file from the path
+    my($prefix,$file) = $obj->_prefix_and_file( $path );
+    $obj->prefix( $prefix );
+    $obj->name( $file );
+
+    return $obj;
+}
+
+sub _prefix_and_file {
+    my $self = shift;
+    my $path = shift;
+
+    my ($vol, $dirs, $file) = File::Spec->splitpath( $path, $self->is_dir );
+    my @dirs = File::Spec->splitdir( $dirs );
+
+    ### so sometimes the last element is '' -- probably when trailing
+    ### dir slashes are encountered... this is is of course pointless,
+    ### so remove it
+    pop @dirs while @dirs and not length $dirs[-1];
+
+    ### if it's a directory, then $file might be empty
+    $file = pop @dirs if $self->is_dir and not length $file;
+
+    my $prefix = File::Spec::Unix->catdir(
+                        grep { length } $vol, @dirs
+                    );
+    return( $prefix, $file );
+}
+
+sub _filetype {
+    my $self = shift;
+    my $file = shift or return;
+
+    return SYMLINK  if (-l $file);	# Symlink
+
+    return FILE     if (-f _);		# Plain file
+
+    return DIR      if (-d _);		# Directory
+
+    return FIFO     if (-p _);		# Named pipe
+
+    return SOCKET   if (-S _);		# Socket
+
+    return BLOCKDEV if (-b _);		# Block special
+
+    return CHARDEV  if (-c _);		# Character special
+
+    ### shouldn't happen, this is when making archives, not reading ###
+    return LONGLINK if ( $file eq LONGLINK_NAME );
+
+    return UNKNOWN;		            # Something else (like what?)
+
+}
+
+### this method 'downgrades' a file to plain file -- this is used for
+### symlinks when FOLLOW_SYMLINKS is true.
+sub _downgrade_to_plainfile {
+    my $entry = shift;
+    $entry->type( FILE );
+    $entry->mode( MODE );
+    $entry->linkname('');
+
+    return 1;
+}
+
+=head2 full_path
+
+Returns the full path from the tar header; this is basically a
+concatenation of the C<prefix> and C<name> fields.
+
+=cut
+
+sub full_path {
+    my $self = shift;
+
+    ### if prefix field is emtpy
+    return $self->name unless defined $self->prefix and length $self->prefix;
+
+    ### or otherwise, catfile'd
+    return File::Spec::Unix->catfile( $self->prefix, $self->name );
+}
+
+
+=head2 validate
+
+Done by Archive::Tar internally when reading the tar file:
+validate the header against the checksum to ensure integer tar file.
+
+Returns true on success, false on failure
+
+=cut
+
+sub validate {
+    my $self = shift;
+
+    my $raw = $self->raw;
+
+    ### don't know why this one is different from the one we /write/ ###
+    substr ($raw, 148, 8) = "        ";
+	return unpack ("%16C*", $raw) == $self->chksum ? 1 : 0;
+}
+
+=head2 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
+content. This method is mainly to make sure you don't get warnings
+for using uninitialized values when looking at an object's content.
+
+=cut
+
+sub has_content {
+    my $self = shift;
+    return defined $self->data() && length $self->data() ? 1 : 0;
+}
+
+=head2 get_content
+
+Returns the current content for the in-memory file
+
+=cut
+
+sub get_content {
+    my $self = shift;
+    $self->data( );
+}
+
+=head2 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
+you are dealing with very large data files in your tar archive, since
+it will pass the contents by reference, rather than make a copy of it
+first.
+
+=cut
+
+sub get_content_by_ref {
+    my $self = shift;
+
+    return \$self->{data};
+}
+
+=head2 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
+you write it.
+
+Returns true on success, false on failure.
+
+=cut
+
+sub replace_content {
+    my $self = shift;
+    my $data = shift || '';
+
+    $self->data( $data );
+    $self->size( length $data );
+    return 1;
+}
+
+=head2 rename( $new_name )
+
+Rename the current file to $new_name.
+
+Note that you must specify a Unix path for $new_name, since per tar
+standard, all files in the archive must be Unix paths.
+
+Returns true on success and false on failure.
+
+=cut
+
+sub rename {
+    my $self = shift;
+    my $path = shift or return;
+
+    my ($prefix,$file) = $self->_prefix_and_file( $path );
+
+    $self->name( $file );
+    $self->prefix( $prefix );
+
+	return 1;
+}
+
+=head1 Convenience methods
+
+To quickly check the type of a C<Archive::Tar::File> object, you can
+use the following methods:
+
+=over 4
+
+=item is_file
+
+Returns true if the file is of type C<file>
+
+=item is_dir
+
+Returns true if the file is of type C<dir>
+
+=item is_hardlink
+
+Returns true if the file is of type C<hardlink>
+
+=item is_symlink
+
+Returns true if the file is of type C<symlink>
+
+=item is_chardev
+
+Returns true if the file is of type C<chardev>
+
+=item is_blockdev
+
+Returns true if the file is of type C<blockdev>
+
+=item is_fifo
+
+Returns true if the file is of type C<fifo>
+
+=item is_socket
+
+Returns true if the file is of type C<socket>
+
+=item is_longlink
+
+Returns true if the file is of type C<LongLink>.
+Should not happen after a successful C<read>.
+
+=item is_label
+
+Returns true if the file is of type C<Label>.
+Should not happen after a successful C<read>.
+
+=item is_unknown
+
+Returns true if the file type is C<unknown>
+
+=back
+
+=cut
+
+#stupid perl5.5.3 needs to warn if it's not numeric
+sub is_file     { local $^W;    FILE      == $_[0]->type }
+sub is_dir      { local $^W;    DIR       == $_[0]->type }
+sub is_hardlink { local $^W;    HARDLINK  == $_[0]->type }
+sub is_symlink  { local $^W;    SYMLINK   == $_[0]->type }
+sub is_chardev  { local $^W;    CHARDEV   == $_[0]->type }
+sub is_blockdev { local $^W;    BLOCKDEV  == $_[0]->type }
+sub is_fifo     { local $^W;    FIFO      == $_[0]->type }
+sub is_socket   { local $^W;    SOCKET    == $_[0]->type }
+sub is_unknown  { local $^W;    UNKNOWN   == $_[0]->type }
+sub is_longlink { local $^W;    LONGLINK  eq $_[0]->type }
+sub is_label    { local $^W;    LABEL     eq $_[0]->type }
+
+1;
diff --git a/lib/Archive/Tar/t/01_use.t b/lib/Archive/Tar/t/01_use.t
new file mode 100644
index 0000000000..0641086306
--- /dev/null
+++ b/lib/Archive/Tar/t/01_use.t
@@ -0,0 +1,7 @@
+use Test::More tests => 2;
+use strict;
+
+use_ok('Archive::Tar') or diag 'Archive::Tar not found -- exit' && die;
+
+my $tar = new Archive::Tar;
+isa_ok( $tar, 'Archive::Tar', 'Object created' );
diff --git a/lib/Archive/Tar/t/02_methods.t b/lib/Archive/Tar/t/02_methods.t
new file mode 100644
index 0000000000..20e37b4d22
--- /dev/null
+++ b/lib/Archive/Tar/t/02_methods.t
@@ -0,0 +1,770 @@
+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';
+
+use Cwd;
+use IO::File;
+use File::Copy;
+use File::Path;
+use File::Spec          ();
+use File::Spec::Unix    ();
+use File::Basename      ();
+use Data::Dumper;
+
+use Archive::Tar;
+use Archive::Tar::Constant;
+
+### XXX TODO:
+### * change to fullname
+### * add tests for global variables
+
+### set up the environment ###
+my @EXPECT_NORMAL = (
+    ### dirs        filename    contents
+    [   [],         'c',        qr/^iiiiiiiiiiii\s*$/ ],
+    [   [],         'd',        qr/^uuuuuuuu\s*$/ ],
+);
+
+### includes binary data
+my $ALL_CHARS = join '', "\r\n", map( chr, 1..255 ), "zzz\n\r";
+
+### @EXPECTBIN is used to ensure that $tarbin is written in the right
+### order and that the contents and order match exactly when extracted
+my @EXPECTBIN = (
+    ###  dirs   filename      contents       ###
+    [    [],    'bIn11',      $ALL_CHARS x 11 ],
+    [    [],    'bIn3',       $ALL_CHARS x  3 ],
+    [    [],    'bIn4',       $ALL_CHARS x  4 ],
+    [    [],    'bIn1',       $ALL_CHARS      ],
+    [    [],    'bIn2',       $ALL_CHARS x  2 ],
+);
+
+### @EXPECTX is used to ensure that $tarx is written in the right
+### order and that the contents and order match exactly when extracted
+### the 'x/x' extraction used to fail before A::T 1.08
+my @EXPECTX = (
+    ###  dirs       filename    contents
+    [    [ 'x' ],   'k',        '',     ],
+    [    [ 'x' ],   'x',        'j',    ],   # failed before A::T 1.08
+);
+
+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')
+                    && length( cwd(). $LONG_FILE ) > 247;
+
+### warn if we are going to skip long file names
+$TOO_LONG ? diag("No long filename support - long filename extraction disabled")
+          : ( push @EXPECT_NORMAL, [ [], $LONG_FILE, qr/^hello\s*$/] ) ;
+
+my @ROOT        = grep { length }   'src', $TOO_LONG ? 'short' : 'long';
+
+my $ZLIB        = eval { require IO::Zlib; 1 } ? 1 : 0;
+my $NO_UNLINK   = $ARGV[0] ? 1 : 0;
+
+### enable debugging?
+$Archive::Tar::DEBUG = 1 if $ARGV[1];
+
+### tests for binary and x/x files
+my $TARBIN      = Archive::Tar->new;
+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 $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';
+chmod 0644, $COMPRESS_FILE;
+
+### done setting up environment ###
+
+
+### did we probe IO::Zlib support ok? ###
+{   is( Archive::Tar->can_handle_compressed_files, $ZLIB,
+                                    "Proper IO::Zlib support detected" );
+}
+
+
+### tar error tests
+{   my $tar     = Archive::Tar->new;
+
+    ok( $tar,                       "Object created" );
+    isa_ok( $tar,                   'Archive::Tar');
+
+    local $Archive::Tar::WARN  = 0;
+
+    ### should be empty to begin with
+    is( $tar->error, '',            "The error string is empty" );
+
+    ### try a read on nothing
+    my @list = $tar->read();
+
+    ok(!(scalar @list),             "Function read returns 0 files on error" );
+    ok( $tar->error,                "   error string is non empty" );
+    like( $tar->error, qr/No file to read from/,
+                                    "   error string from create()" );
+    unlike( $tar->error, qr/add/,   "   error string does not contain add" );
+
+    ### now, add empty data
+    my $obj = $tar->add_data( '' );
+
+    ok( !$obj,                      "'add_data' returns undef on error" );
+    ok( $tar->error,                "   error string is non empty" );
+    like( $tar->error, qr/add/,     "   error string contains add" );
+    unlike( $tar->error, qr/create/,"   error string does not contain create" );
+
+    ### check if ->error eq $error
+    is( $tar->error, $Archive::Tar::error,
+                                    '$error matches error() method' );
+}
+
+### 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: {
+
+            ### skip gz compressed archives wihtout IO::Zlib
+            skip(   "No IO::Zlib - cannot read compressed archives",
+                    4 + 2 * (scalar @EXPECT_NORMAL)
+            ) if( $gzip and !$ZLIB);
+
+            ### ->read test
+            {   my @list    = $tar->read( $type );
+                my $cnt     = scalar @list;
+                my $expect  = scalar __PACKAGE__->get_expect();
+
+                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" );
+
+                    next unless $file->is_file;
+
+                    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'" );
+
+                    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();
+
+                ok( $cnt,           "Reading $state file using 'list_archive'");
+                is( $cnt, $expect,  "   All files accounted for" );
+
+                for my $file ( @list ) {
+                    next if __PACKAGE__->is_dir( $file ); # directories
+
+                    my($expect_name, $expect_content) =
+                        get_expect_name_and_contents( $file, \@EXPECT_NORMAL );
+
+                    ok( $expect_name,
+                                    "   Found expected file '$file'" );
+                }
+            }
+        }
+
+        ### now we try gz compressed archives
+        $gzip++;
+    }
+}
+
+### add files tests ###
+{   my @add     = map { File::Spec->catfile( @ROOT, @$_ ) } ['b'];
+    my @addunix = map { File::Spec::Unix->catfile( @ROOT, @$_ ) } ['b'];
+    my $tar     = Archive::Tar->new;
+
+    ### check we got the object
+    ok( $tar,                       "Object created" );
+    isa_ok( $tar,                   'Archive::Tar');
+
+    ### add the files
+    {   my @files = $tar->add_files( @add );
+
+        is( scalar @files, scalar @add,
+                                    "Adding files");
+        is( $files[0]->name, 'b',   "   Proper name" );
+        is( $files[0]->is_file, 1,  "   Proper type" );
+        like( $files[0]->get_content, qr/^bbbbbbbbbbb\s*$/,
+                                    "   Content OK" );
+
+        ### check if we have then in our tar object
+        for my $file ( @addunix ) {
+            ok( $tar->contains_file($file),
+                                    "   File found in archive" );
+        }
+    }
+
+    ### check adding files doesn't conflict with a secondary archive
+    ### old A::T bug, we should keep testing for it
+    {   my $tar2    = Archive::Tar->new;
+        my @added   = $tar2->add_files( $COMPRESS_FILE );
+        my @count   = $tar2->list_files;
+
+        is( scalar @added, 1,       "Added files to secondary archive" );
+        is( scalar @added, scalar @count,
+                                    "   Does not conflict with first archive" );
+
+        ### check the adding of directories
+        my @add_dirs  = File::Spec->catfile( @ROOT );
+        my @dirs      = $tar2->add_files( @add_dirs );
+        is( scalar @dirs, scalar @add_dirs,
+                                    "Adding dirs");
+        ok( $dirs[0]->is_dir,       "   Proper type" );
+    }
+}
+
+### add data tests ###
+{
+    {   ### standard data ###
+        my @to_add  = ( 'a', 'aaaaa' );
+        my $tar     = Archive::Tar->new;
+
+        ### check we got the object
+        ok( $tar,                   "Object created" );
+        isa_ok( $tar,               'Archive::Tar');
+
+        ### add a new file item as data
+        my $obj = $tar->add_data( @to_add );
+
+        ok( $obj,                   "Adding data" );
+        is( $obj->name, $to_add[0], "   Proper name" );
+        is( $obj->is_file, 1,       "   Proper type" );
+        like( $obj->get_content, qr/^$to_add[1]\s*$/,
+                                    "   Content OK" );
+    }
+
+    {   ### binary data +
+        ### dir/file structure -- x/y always went ok, x/x used to extract
+        ### in the wrong way -- this test catches that
+        for my $list (  [$TARBIN,   \@EXPECTBIN],
+                        [$TARX,     \@EXPECTX],
+        ) {
+            ### XXX GLOBAL! changes may affect other tests!
+            my($tar,$struct) = @$list;
+
+            for my $aref ( @$struct ) {
+                my ($dirs,$file,$data) = @$aref;
+
+                my $path = File::Spec::Unix->catfile(
+                                grep { length } @$dirs, $file );
+
+                my $obj = $tar->add_data( $path, $data );
+
+                ok( $obj,               "Adding data '$file'" );
+                is( $obj->full_path, $path,
+                                        "   Proper name" );
+                ok( $obj->is_file,      "   Proper type" );
+                is( $obj->get_content, $data,
+                                        "   Content OK" );
+            }
+        }
+    }
+}
+
+### rename/replace_content tests ###
+{   my $tar     = Archive::Tar->new;
+    my $from    = 'c';
+    my $to      = 'e';
+
+    ### read in the file, check the proper files are there
+    ok( $tar->read( $TAR_FILE ),    "Read in '$TAR_FILE'" );
+    ok( $tar->get_files($from),     "   Found file '$from'" );
+    {   local $Archive::Tar::WARN = 0;
+        ok(!$tar->get_files($to),   "   File '$to' not yet found" );
+    }
+
+    ### rename an entry, check the rename has happened
+    ok( $tar->rename( $from, $to ), "   Renamed '$from' to '$to'" );
+    ok( $tar->get_files($to),       "   File '$to' now found" );
+    {   local $Archive::Tar::WARN = 0;
+        ok(!$tar->get_files($from), "   File '$from' no longer found'");
+    }
+
+    ### now, replace the content
+    my($expect_name, $expect_content) =
+                        get_expect_name_and_contents( $from, \@EXPECT_NORMAL );
+
+    like( $tar->get_content($to), $expect_content,
+                                    "Original content of '$from' in '$to'" );
+    ok( $tar->replace_content( $to, $from ),
+                                    "   Set content for '$to' to '$from'" );
+    is( $tar->get_content($to), $from,
+                                    "   Content for '$to' is indeed '$from'" );
+}
+
+### remove tests ###
+{   my $remove  = 'c';
+    my $tar     = Archive::Tar->new;
+
+    ok( $tar->read( $TAR_FILE ),    "Read in '$TAR_FILE'" );
+
+    ### remove returns the files left, which should be equal to list_files
+    is( scalar($tar->remove($remove)), scalar($tar->list_files),
+                                    "Removing file '$remove'" );
+
+    ### so what's left should be all expected files minus 1
+    is( scalar($tar->list_files), scalar(__PACKAGE__->get_expect) - 1,
+                                    "   Proper files remaining" );
+}
+
+### write + read + extract tests ###
+SKIP: {
+    skip('no IO::String', 326) if   !$Archive::Tar::HAS_PERLIO && 
+                                    !$Archive::Tar::HAS_IO_STRING;
+                                    
+    my $tar = Archive::Tar->new;
+    my $new = Archive::Tar->new;
+    ok( $tar->read( $TAR_FILE ),    "Read in '$TAR_FILE'" );
+
+    for my $aref (  [$tar,    \@EXPECT_NORMAL],
+                    [$TARBIN, \@EXPECTBIN],
+                    [$TARX,   \@EXPECTX]
+    ) {
+        my($obj,$struct) = @$aref;
+
+        ### check if we stringify it ok
+        {   my $string = $obj->write;
+            ok( $string,           "Stringified tar file has size" );
+            cmp_ok( length($string) % BLOCK, '==', 0,
+                                    "Tar archive stringified" );
+        }
+
+        ### write tar tests
+        {   my $out = $OUT_TAR_FILE;
+
+            {   ### write()
+                ok( $obj->write($out),
+                                    "Wrote tarfile using 'write'" );
+                check_tar_file( $out );
+                check_tar_object( $obj, $struct );
+
+                ### now read it in again
+                ok( $new->read( $out ),
+                                    "Read '$out' in again" );
+
+                check_tar_object( $new, $struct );
+
+                ### now extract it again
+                ok( $new->extract,  "Extracted '$out' with 'extract'" );
+                check_tar_extract( $new, $struct );
+
+                rm( $out ) unless $NO_UNLINK;
+            }
+
+
+            {   ### create_archive()
+                ok( Archive::Tar->create_archive( $out, 0, $COMPRESS_FILE ),
+                                    "Wrote tarfile using 'create_archive'" );
+                check_tar_file( $out );
+
+                ### now extract it again
+                ok( Archive::Tar->extract_archive( $out ),
+                                    "Extracted file using 'extract_archive'");
+                rm( $out ) unless $NO_UNLINK;
+            }
+        }
+
+        ## 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
+
+                skip( "No IO::Zlib - cannot write compressed archives", $cnt )
+                    unless $ZLIB;
+
+                {   ### write()
+                    ok($obj->write($out, 1),
+                                    "Writing compressed file using 'write'" );
+                    check_tgz_file( $out );
+                    check_tar_object( $obj, $struct );
+
+                    ### now read it in again
+                    ok( $new->read( $out ),
+                                    "Read '$out' in again" );
+                    check_tar_object( $new, $struct );
+
+                    ### now extract it again
+                    ok( $new->extract,
+                                    "Extracted '$out' again" );
+                    check_tar_extract( $new, $struct );
+
+                    rm( $out ) unless $NO_UNLINK;
+                }
+
+                {   ### create_archive()
+                    ok( Archive::Tar->create_archive( $out, 1, $COMPRESS_FILE ),
+                                    "Wrote gzip file using 'create_archive'" );
+                    check_tgz_file( $out );
+
+                    ### now extract it again
+                    ok( Archive::Tar->extract_archive( $out, 1 ),
+                                    "Extracted file using 'extract_archive'");
+                    rm( $out ) unless $NO_UNLINK;
+                }
+            }
+        }
+    }
+}
+
+
+### limited read + extract tests ###
+{   my $tar     = Archive::Tar->new;
+    my @files   = $tar->read( $TAR_FILE, 0, { limit => 1 } );
+    my $obj     = $files[0];
+
+    is( scalar @files, 1,           "Limited read" );
+
+    my ($name,$content) = get_expect_name_and_contents(
+                                $obj->full_path, \@EXPECT_NORMAL );
+
+    is( $obj->name, $name,          "   Expected file found" );
+
+    ### extract this single file to cwd()
+    for my $meth (qw[extract extract_file]) {
+        ok( $tar->$meth( $obj->full_path ),
+                                    "Extracted '$name' to cwd() with $meth" );
+        ok( -e $obj->full_path,     "   Extracted file exists" );
+        rm( $obj->full_path ) unless $NO_UNLINK;
+    }
+
+    ### extract this file to @ROOT
+    ### can only do that with 'extract_file', not with 'extract'
+    for my $meth (qw[extract_file]) {
+        my $outpath = File::Spec->catdir( @ROOT );
+        my $outfile = File::Spec->catfile( $outpath, $$ ); #$obj->full_path );
+
+        ok( $tar->$meth( $obj->full_path, $outfile ),
+                                    "Extracted file '$name' to $outpath with $meth" );
+        ok( -e $outfile,            "   Extracted file '$outfile' exists" );
+        rm( $outfile ) unless $NO_UNLINK;
+    }
+
+}
+
+
+### clear tests ###
+{   my $tar     = Archive::Tar->new;
+    my @files   = $tar->read( $TAR_FILE );
+
+    my $cnt = $tar->list_files();
+    ok( $cnt,                       "Found old data" );
+    ok( $tar->clear,                "   Clearing old data" );
+
+    my $new_cnt = $tar->list_files;
+    ok( !$new_cnt,                  "   Old data cleared" );
+}
+
+### $DO_NOT_USE_PREFIX tests
+{   my $tar     = Archive::Tar->new;
+
+
+    ### first write a tar file without prefix
+    {   my ($obj)   = $tar->add_files( $COMPRESS_FILE );
+        my $dir     = '';   # dir is empty!
+        my $file    = File::Basename::basename( $COMPRESS_FILE );
+
+        ok( $obj,                   "File added" );
+        isa_ok( $obj,               "Archive::Tar::File" );
+
+        ### internal storage ###
+        is( $obj->name, $file,      "   Name set to '$file'" );
+        is( $obj->prefix, $dir,     "   Prefix set to '$dir'" );
+
+        ### write the tar file without a prefix in it
+        local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
+        ok( $tar->write( $OUT_TAR_FILE ),
+                                    "   Tar file written" );
+
+        ### and forget all about it...
+        $tar->clear;
+    }
+
+    ### now read it back in, there should be no prefix
+    {   ok( $tar->read( $OUT_TAR_FILE ),
+                                    "Tar file read in again" );
+
+        my ($obj) = $tar->get_files;
+        ok( $obj,                   "   File retrieved" );
+        isa_ok( $obj,               "Archive::Tar::File" );
+
+        is( $obj->name, $COMPRESS_FILE,
+                                    "   Name now set to '$COMPRESS_FILE'" );
+        is( $obj->prefix, '',       "   Prefix now empty" );
+
+        my $re = quotemeta $COMPRESS_FILE;
+        like( $obj->raw, qr/^$re/,  "   Prefix + name in name slot of header" );
+    }
+
+    rm( $OUT_TAR_FILE ) unless $NO_UNLINK;
+}
+
+### clean up stuff
+END {
+    for my $struct ( \@EXPECT_NORMAL, \@EXPECTBIN, \@EXPECTX ) {
+        for my $aref (@$struct) {
+
+            my $dir = $aref->[0]->[0];
+            rmtree $dir if $dir && -d $dir && not $NO_UNLINK;
+        }
+    }
+
+    my ($dir) = File::Spec::Unix->splitdir( $LONG_FILE );
+    rmtree $dir if $dir && -d $dir && not $NO_UNLINK;
+}
+
+###########################
+###     helper subs     ###
+###########################
+sub get_expect {
+    return  map {
+                split '/', $_
+            } map {
+                File::Spec::Unix->catfile(
+                    grep { defined } @{$_->[0]}, $_->[1]
+                )
+            } @EXPECT_NORMAL;
+}
+
+sub is_dir {
+    my $file = pop();
+    return $file =~ m|/$| ? 1 : 0;
+}
+
+sub rm {
+    my $x = shift;
+    is_dir($x) ? rmtree($x) : unlink $x;
+}
+
+sub check_tar_file {
+    my $file        = shift;
+    my $filesize    = -s $file;
+    my $contents    = slurp_binfile( $file );
+
+    ok( defined( $contents ),   "   File read" );
+    ok( $filesize,              "   File written size=$filesize" );
+
+    cmp_ok( $filesize % BLOCK,     '==', 0,
+                        "   File size is a multiple of 512" );
+
+    cmp_ok( length($contents), '==', $filesize,
+                        "   File contents match size" );
+
+    is( TAR_END x 2, substr( $contents, -(BLOCK*2) ),
+                        "   Ends with 1024 null bytes" );
+
+    return $contents;
+}
+
+sub check_tgz_file {
+    my $file                = shift;
+    my $filesize            = -s $file;
+    my $contents            = slurp_gzfile( $file );
+    my $uncompressedsize    = length $contents;
+
+    ok( defined( $contents ),   "   File read and uncompressed" );
+    ok( $filesize,              "   File written size=$filesize uncompressed size=$uncompressedsize" );
+
+    cmp_ok( $uncompressedsize % BLOCK, '==', 0,
+                                "   Uncompressed size is a multiple of 512" );
+
+    is( TAR_END x 2, substr($contents, -(BLOCK*2)),
+                                "   Ends with 1024 null bytes" );
+
+    cmp_ok( $filesize, '<',  $uncompressedsize,
+                                "   Compressed size < uncompressed size" );
+
+    return $contents;
+}
+
+sub check_tar_object {
+    my $obj     = shift;
+    my $struct  = shift or return;
+
+    ### amount of files (not dirs!) there should be in the object
+    my $expect  = scalar @$struct;
+    my @files   = grep { $_->is_file } $obj->get_files;
+
+    ### count how many files there are in the object
+    ok( scalar @files,          "   Found some files in the archive" );
+    is( scalar @files, $expect, "   Found expected number of files" );
+
+    for my $file (@files) {
+
+        ### XXX ->fullname
+        #my $path = File::Spec::Unix->catfile(
+        #            grep { length } $file->prefix, $file->name );
+        my($ename,$econtent) =
+            get_expect_name_and_contents( $file->full_path, $struct );
+
+        ok( $file->is_file,     "   It is a file" );
+        is( $file->full_path, $ename,
+                                "   Name matches expected name" );
+        like( $file->get_content, $econtent,
+                                "   Content as expected" );
+    }
+}
+
+sub check_tar_extract {
+    my $tar     = shift;
+    my $struct  = shift;
+
+    my @dirs;
+    for my $file ($tar->get_files) {
+        push @dirs, $file && next if $file->is_dir;
+
+
+        my $path = $file->full_path;
+        my($ename,$econtent) =
+            get_expect_name_and_contents( $path, $struct );
+
+
+        is( $ename, $path,          "   Expected file found" );
+        ok( -e $path,               "   File '$path' exists" );
+
+        my $fh;
+        open $fh, "$path" or warn "Error opening file '$path': $!\n";
+        binmode $fh;
+
+        ok( $fh,                    "   Opening file" );
+
+        my $content = do{local $/;<$fh>}; chomp $content;
+        like( $content, qr/$econtent/,
+                                    "   Contents OK" );
+
+        unlink $path unless $NO_UNLINK;
+
+        ### alternate extract path tests 
+        ### to abs and rel paths
+        {   for my $outpath (   File::Spec->catdir( @ROOT ),
+                                File::Spec->rel2abs( 
+                                    File::Spec->catdir( @ROOT )
+                                )
+            ) {
+            
+                my $outfile = File::Spec->catfile( $outpath, $$ ); 
+    
+                ok( $tar->extract_file( $file->full_path, $outfile ),
+                                "   Extracted file '$path' to $outfile" );
+                ok( -e $outfile,"   Extracted file '$outfile' exists" );
+    
+                rm( $outfile ) unless $NO_UNLINK;
+            }            
+        }
+    }
+
+    ### now check if list_files is returning the same info as get_files
+    is_deeply( [$tar->list_files], [ map { $_->full_path } $tar->get_files],
+                                    "   Verified via list_files as well" );
+
+    #do { rmtree $_->full_path if -d $_->full_path && not $NO_UNLINK }
+    #    for @dirs;
+}
+
+sub slurp_binfile {
+    my $file    = shift;
+    my $fh      = IO::File->new;
+
+    $fh->open( $file ) or warn( "Error opening '$file': $!" ), return undef;
+
+    binmode $fh;
+    local $/;
+    return <$fh>;
+}
+
+sub slurp_gzfile {
+    my $file = shift;
+    my $str;
+    my $buff;
+
+    require IO::Zlib;
+    my $fh = new IO::Zlib;
+    $fh->open( $file, READ_ONLY->(1) )
+        or warn( "Error opening '$file' with IO::Zlib" ), return undef;
+
+    $str .= $buff while $fh->read( $buff, 4096 ) > 0;
+    $fh->close();
+    return $str;
+}
+
+sub get_expect_name_and_contents {
+    my $find    = shift;
+    my $struct  = shift or return;
+
+    ### find the proper name + contents for this file from
+    ### the expect structure
+    my ($name, $content) =
+        map {
+            @$_;
+        } grep {
+            $_->[0] eq $find
+        } map {
+            [   ### full path ###
+                File::Spec::Unix->catfile(
+                    grep { length } @{$_->[0]}, $_->[1]
+                ),
+                ### regex
+                $_->[2],
+            ]
+        } @$struct;
+
+    ### not a qr// yet?
+    unless( ref $content ) {
+        my $x     = quotemeta ($content || '');
+        $content = qr/$x/;
+    }
+
+    unless( $name ) {
+        warn "Could not find '$find' in " . Dumper $struct;
+    }
+
+    return ($name, $content);
+}
+
+__END__
diff --git a/lib/Archive/Tar/t/03_file.t b/lib/Archive/Tar/t/03_file.t
new file mode 100644
index 0000000000..9d4e7553ee
--- /dev/null
+++ b/lib/Archive/Tar/t/03_file.t
@@ -0,0 +1,139 @@
+### This program tests Archive::Tar::File ###
+
+use Test::More 'no_plan';
+use strict;
+
+use File::Spec::Unix  ();
+
+use Archive::Tar::File;
+use Archive::Tar::Constant;
+
+my $all_chars         = join '', "\r\n", map( chr, 0..255 ), "zzz\n\r";
+my $start_time        = time() - 1 - TIME_OFFSET;
+my $replace_contents  = $all_chars x 42;
+
+my $rename_path                 = 'x/yy/42';
+my ($rename_dir, $rename_file)  = dir_and_file( $rename_path );
+
+my @test_files = (
+    ###  pathname         contents          optional hash of attributes ###
+    [    'x/bIn1',        $all_chars                                      ],
+    [    'bIn2',          $all_chars x 2                                  ],
+    [    'bIn0',          ''                                              ],
+    
+    ### keep this one as the last entry
+    [    'x/yy/z',        '',               { type  => DIR,
+                                              mode  => 0777,
+                                              uid   => 42,
+                                              gid   => 43,
+                                              uname => 'Ford',
+                                              gname => 'Prefect',
+                                              mtime => $start_time }      ],
+);
+
+### new( data => ... ) tests ###
+for my $f ( @test_files ) {
+    my $unix_path     = $f->[0];
+    my $contents      = $f->[1];
+    my $attr          = $f->[2] || {};
+    my ($dir, $file)  = dir_and_file( $unix_path );
+
+    my $obj = Archive::Tar::File->new( data => $unix_path, $contents, $attr );
+
+    isa_ok( $obj,       'Archive::Tar::File',    "Object created" );
+    is( $obj->name,     $file,                   "   name '$file' ok" );
+    is( $obj->prefix,   $dir,                    "   prefix '$dir' ok" );
+    is( $obj->size,     length($contents),       "   size ok" );
+    is( $obj->mode,     exists($attr->{mode}) ? $attr->{mode} : MODE,
+                                                 "   mode ok" );
+    is( $obj->uid,      exists($attr->{uid}) ? $attr->{uid} : UID,
+                                                 "   uid ok" );
+    is( $obj->gid,      exists($attr->{gid}) ? $attr->{gid} : GID,
+                                                 "   gid ok" );
+    is( $obj->uname,    exists($attr->{uname}) ? $attr->{uname} : UNAME->(UID ),
+                                                 "   uname ok" );
+    is( $obj->gname,    exists($attr->{gname}) ? $attr->{gname} : GNAME->( GID ),
+                                                 "   gname ok" );
+    is( $obj->type,     exists($attr->{type}) ? $attr->{type} : FILE,
+                                                 "   type ok" );
+    if (exists($attr->{mtime})) {
+        is( $obj->mtime, $attr->{mtime},         "   mtime matches" );
+    } else {
+        cmp_ok( $obj->mtime, '>', $start_time,   "   mtime after start time" );
+    }
+    ok( $obj->chksum,                            "   chksum ok" );
+    ok( $obj->version,                           "   version ok" );
+    ok( ! $obj->linkname,                        "   linkname ok" );
+    ok( ! $obj->devmajor,                        "   devmajor ok" );
+    ok( ! $obj->devminor,                        "   devminor ok" );
+    ok( ! $obj->raw,                             "   raw ok" );
+
+    ### test type checkers 
+    SKIP: {
+        skip "Attributes defined, may not be plainfile", 11 if keys %$attr;
+        
+        ok( $obj->is_file,                      "   Object is a file" );
+        
+        for my $name (qw[dir hardlink symlink chardev blockdev fifo 
+                         socket unknown longlink label ]
+        ) {
+            my $method = 'is_' . $name;
+            
+            ok(!$obj->$method(),               "   Object is not a '$name'");
+        }
+    }        
+
+    ### Use "ok" not "is" to avoid binary data screwing up the screen ###
+    ok( $obj->get_content eq $contents,          "   get_content ok" );
+    ok( ${$obj->get_content_by_ref} eq $contents,
+                                                 "   get_content_by_ref ok" );
+    is( $obj->has_content, length($contents) ? 1 : 0,
+                                                 "   has_content ok" );
+    ok( $obj->replace_content( $replace_contents ),
+                                                 "   replace_content ok" );
+    ok( $obj->get_content eq $replace_contents,  "   get_content ok" );
+    ok( $obj->replace_content( $contents ),      "   replace_content ok" );
+    ok( $obj->get_content eq $contents,          "   get_content ok" );
+
+    ok( $obj->rename( $rename_path ),            "   rename ok" );
+    is( $obj->name,     $rename_file,            "   name '$file' ok" );
+    is( $obj->prefix,   $rename_dir,             "   prefix '$dir' ok" );
+    ok( $obj->rename( $unix_path ),              "   rename ok" );
+    is( $obj->name,     $file,                   "   name '$file' ok" );
+    is( $obj->prefix,   $dir,                    "   prefix '$dir' ok" );
+
+    ### clone tests ###
+    my $clone = $obj->clone;
+    isnt( $obj, $clone,                         "Clone is different object" );
+    is_deeply( $obj, $clone,                    "   Clone holds same data" );
+}
+
+### _downgrade_to_plainfile
+{   my $aref        = $test_files[-1];
+    my $unix_path   = $aref->[0];
+    my $contents    = $aref->[1];
+    my $attr        = $aref->[2];     
+    
+    my $obj = Archive::Tar::File->new( data => $unix_path, $contents, $attr );
+    
+    ### check if the object is as expected
+    isa_ok( $obj,                           'Archive::Tar::File' );
+    ok( $obj->is_dir,                       "   Is a directory" );
+    
+    ### do the downgrade 
+    ok( $obj->_downgrade_to_plainfile,      "   Downgraded to plain file" );
+    
+    ### now check if it's downgraded
+    ok( $obj->is_file,                      "   Is now a file" );
+    is( $obj->linkname, '',                 "   No link entered" );
+    is( $obj->mode, MODE,                   "   Mode as expected" );
+}    
+ 
+### helper subs ###
+sub dir_and_file {
+    my $unix_path = shift;
+    my ($vol, $dirs, $file) = File::Spec::Unix->splitpath( $unix_path );
+    my $dir = File::Spec::Unix->catdir( grep { length } $vol,
+                                        File::Spec::Unix->splitdir( $dirs ) );
+    return ( $dir, $file );
+}
diff --git a/lib/Archive/Tar/t/99_pod.t b/lib/Archive/Tar/t/99_pod.t
new file mode 100644
index 0000000000..8e4084c680
--- /dev/null
+++ b/lib/Archive/Tar/t/99_pod.t
@@ -0,0 +1,18 @@
+use Test::More;
+use File::Spec;
+use File::Find;
+use strict;
+
+eval 'use Test::Pod';
+plan skip_all => "Test::Pod v0.95 required for testing POD"
+    if $@ || $Test::Pod::VERSION < 0.95;
+
+my @files;
+find( sub { push @files, $File::Find::name if /\.p(?:l|m|od)$/ },
+    File::Spec->catfile( qw(blib lib) ) );
+plan tests => scalar @files;
+for my $file ( @files ) {
+    pod_file_ok( $file );
+}
+
+
diff --git a/lib/Archive/Tar/t/src/long/b b/lib/Archive/Tar/t/src/long/b
new file mode 100644
index 0000000000..38f6d2d61d
--- /dev/null
+++ b/lib/Archive/Tar/t/src/long/b
@@ -0,0 +1 @@
+bbbbbbbbbbb
diff --git a/lib/Archive/Tar/t/src/long/bar.tar b/lib/Archive/Tar/t/src/long/bar.tar
new file mode 100644
index 0000000000..d4a12bd075
--- /dev/null
+++ b/lib/Archive/Tar/t/src/long/bar.tar
diff --git a/lib/Archive/Tar/t/src/long/foo.tgz b/lib/Archive/Tar/t/src/long/foo.tgz
new file mode 100644
index 0000000000..98657c01f6
--- /dev/null
+++ b/lib/Archive/Tar/t/src/long/foo.tgz
diff --git a/lib/Archive/Tar/t/src/short/b b/lib/Archive/Tar/t/src/short/b
new file mode 100644
index 0000000000..38f6d2d61d
--- /dev/null
+++ b/lib/Archive/Tar/t/src/short/b
@@ -0,0 +1 @@
+bbbbbbbbbbb
diff --git a/lib/Archive/Tar/t/src/short/bar.tar b/lib/Archive/Tar/t/src/short/bar.tar
new file mode 100644
index 0000000000..cf5fd276ad
--- /dev/null
+++ b/lib/Archive/Tar/t/src/short/bar.tar
diff --git a/lib/Archive/Tar/t/src/short/foo.tgz b/lib/Archive/Tar/t/src/short/foo.tgz
new file mode 100644
index 0000000000..de54e7d0bf
--- /dev/null
+++ b/lib/Archive/Tar/t/src/short/foo.tgz