$DEBUG = 0;
$WARN = 1;
$FOLLOW_SYMLINK = 0;
-$VERSION = "1.39_04";
+$VERSION = "1.40";
$CHOWN = 1;
$CHMOD = 1;
$DO_NOT_USE_PREFIX = 0;
$self->{cwd} = $cwd;
}
-=head2 $bool = $tar->has_io_string
-
-Returns true if we currently have C<IO::String> support loaded.
-
-Either C<IO::String> or C<perlio> support is needed to support writing
-stringified archives. Currently, C<perlio> is the preferred method, if
-available.
-
-See the C<GLOBAL VARIABLES> section to see how to change this preference.
-
-=cut
-
-sub has_io_string { return $HAS_IO_STRING; }
-
-=head2 $bool = $tar->has_perlio
-
-Returns true if we currently have C<perlio> support loaded.
-
-This requires C<perl-5.8> or higher, compiled with C<perlio>
-
-Either C<IO::String> or C<perlio> support is needed to support writing
-stringified archives. Currently, C<perlio> is the preferred method, if
-available.
-
-See the C<GLOBAL VARIABLES> section to see how to change this preference.
-
-=cut
-
-sub has_perlio { return $HAS_PERLIO; }
-
-
=head1 Class Methods
=head2 Archive::Tar->create_archive($file, $compressed, @filelist)
return $tar->read( $file, $gzip, { extract => 1 } );
}
+=head2 $bool = Archive::Tar->has_io_string
+
+Returns true if we currently have C<IO::String> support loaded.
+
+Either C<IO::String> or C<perlio> support is needed to support writing
+stringified archives. Currently, C<perlio> is the preferred method, if
+available.
+
+See the C<GLOBAL VARIABLES> section to see how to change this preference.
+
+=cut
+
+sub has_io_string { return $HAS_IO_STRING; }
+
+=head2 $bool = Archive::Tar->has_perlio
+
+Returns true if we currently have C<perlio> support loaded.
+
+This requires C<perl-5.8> or higher, compiled with C<perlio>
+
+Either C<IO::String> or C<perlio> support is needed to support writing
+stringified archives. Currently, C<perlio> is the preferred method, if
+available.
+
+See the C<GLOBAL VARIABLES> section to see how to change this preference.
+
+=cut
+
+sub has_perlio { return $HAS_PERLIO; }
+
+=head2 $bool = Archive::Tar->has_zlib_support
+
+Returns true if C<Archive::Tar> can extract C<zlib> compressed archives
+
+=cut
+
+sub has_zlib_support { return ZLIB }
+
+=head2 $bool = Archive::Tar->has_bzip2_support
+
+Returns true if C<Archive::Tar> can extract C<bzip2> compressed archives
+
+=cut
+
+sub has_bzip2_support { return BZIP }
+
=head2 Archive::Tar->can_handle_compressed_files
A simple checking routine, which will return true if C<Archive::Tar>
=head1 COPYRIGHT
-This module is copyright (c) 2002 - 2007 Jos Boumans
+This module is copyright (c) 2002 - 2008 Jos Boumans
E<lt>kane@cpan.orgE<gt>. All rights reserved.
This library is free software; you may redistribute and/or modify
use File::Basename ();
use Data::Dumper;
-use Archive::Tar;
+### need the constants at compile time;
use Archive::Tar::Constant;
+my $Class = 'Archive::Tar';
+use_ok( $Class );
+
+
+
### XXX TODO:
### * change to fullname
### * add tests for global variables
}
my @ROOT = grep { length } 'src', $TOO_LONG ? 'short' : 'long';
-
-my $ZLIB = eval { require IO::Zlib;
- require IO::Compress::Bzip2; 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?
-$Archive::Tar::DEBUG = 1 if $ARGV[1];
+### enable debugging?
+### pesky warnings
+$Archive::Tar::DEBUG = $Archive::Tar::DEBUG = 1 if $ARGV[1];
### tests for binary and x/x files
-my $TARBIN = Archive::Tar->new;
-my $TARX = Archive::Tar->new;
+my $TARBIN = $Class->new;
+my $TARX = $Class->new;
### paths to a .tar and .tgz file to use for tests
my $TAR_FILE = File::Spec->catfile( @ROOT, 'bar.tar' );
### done setting up environment ###
+### check for zlib/bzip2 support
+{ for my $meth ( qw[has_zlib_support has_bzip2_support] ) {
+ can_ok( $Class, $meth );
+ }
+}
-### 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;
+{ my $tar = $Class->new;
ok( $tar, "Object created" );
isa_ok( $tar, 'Archive::Tar');
### check if ->error eq $error
is( $tar->error, $Archive::Tar::error,
- '$error matches error() method' );
+ "Error '$Archive::Tar::error' matches $Class->error method" );
### check that 'contains_file' doesn't warn about missing files.
{ ### turn on warnings in general!
### read tests ###
{ my @to_try = ($TAR_FILE);
- push @to_try, $TGZ_FILE if $ZLIB;
- push @to_try, $TBZ_FILE if $BZIP;
+ push @to_try, $TGZ_FILE if $Class->has_zlib_support;
+ push @to_try, $TBZ_FILE if $Class->has_bzip2_support;
for my $type( @to_try ) {
### normal tar + gz compressed file
- my $tar = Archive::Tar->new;
+ my $tar = $Class->new;
### check we got the object
ok( $tar, "Object created" );
### list_archive test
- { my @list = Archive::Tar->list_archive( $type );
+ { my @list = $Class->list_archive( $type );
my $cnt = scalar @list;
my $expect = scalar __PACKAGE__->get_expect();
### 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;
+ my $tar = $Class->new;
### check we got the object
ok( $tar, "Object created" );
### 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 $tar2 = $Class->new;
my @added = $tar2->add_files( $COMPRESS_FILE );
my @count = $tar2->list_files;
{
{ ### standard data ###
my @to_add = ( 'a', 'aaaaa' );
- my $tar = Archive::Tar->new;
+ my $tar = $Class->new;
### check we got the object
ok( $tar, "Object created" );
}
### rename/replace_content tests ###
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
my $from = 'c';
my $to = 'e';
### remove tests ###
{ my $remove = 'c';
- my $tar = Archive::Tar->new;
+ my $tar = $Class->new;
ok( $tar->read( $TAR_FILE ), "Read in '$TAR_FILE'" );
}
### write + read + extract tests ###
-SKIP: {
+SKIP: { ### pesky warnings
skip('no IO::String', 326) if !$Archive::Tar::HAS_PERLIO &&
+ !$Archive::Tar::HAS_PERLIO &&
+ !$Archive::Tar::HAS_IO_STRING &&
!$Archive::Tar::HAS_IO_STRING;
- my $tar = Archive::Tar->new;
- my $new = Archive::Tar->new;
+ my $tar = $Class->new;
+ my $new = $Class->new;
ok( $tar->read( $TAR_FILE ), "Read in '$TAR_FILE'" );
for my $aref ( [$tar, \@EXPECT_NORMAL],
{ ### create_archive()
- ok( Archive::Tar->create_archive( $out, 0, $COMPRESS_FILE ),
+ ok( $Class->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 ),
+ ok( $Class->extract_archive( $out ),
"Extracted file using 'extract_archive'");
rm( $out ) unless $NO_UNLINK;
}
## write tgz tests
{ my @out;
- push @out, [ $OUT_TGZ_FILE => 1 ] if $ZLIB;
- push @out, [ $OUT_TBZ_FILE => COMPRESS_BZIP ] if $BZIP;
+ push @out, [ $OUT_TGZ_FILE => 1 ] if $Class->has_zlib_support;
+ push @out, [ $OUT_TBZ_FILE => COMPRESS_BZIP ] if $Class->has_bzip2_support;
for my $entry ( @out ) {
}
{ ### create_archive()
- ok( Archive::Tar->create_archive( $out, $compression, $COMPRESS_FILE ),
+ ok( $Class->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, $compression ),
+ ok( $Class->extract_archive( $out, $compression ),
"Extracted file using 'extract_archive'");
rm( $out ) unless $NO_UNLINK;
}
### limited read + extract tests ###
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
my @files = $tar->read( $TAR_FILE, 0, { limit => 1 } );
my $obj = $files[0];
### clear tests ###
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
my @files = $tar->read( $TAR_FILE );
my $cnt = $tar->list_files();
}
### $DO_NOT_USE_PREFIX tests
-{ my $tar = Archive::Tar->new;
+{ my $tar = $Class->new;
### first write a tar file without prefix
is( $obj->prefix, $dir, " Prefix set to '$dir'" );
### write the tar file without a prefix in it
+ ### pesky warnings
local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
+ local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
+
ok( $tar->write( $OUT_TAR_FILE ),
" Tar file written" );
projects / platform / upstream / perl.git / commitdiff