r29968 - in /branches/upstream/libarchive-tar-perl/current: CHANGES META.yml Makefile.PL lib/Archive/Tar.pm t/02_methods.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sat Jan 24 01:12:28 UTC 2009
Author: gregoa
Date: Sat Jan 24 01:12:25 2009
New Revision: 29968
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=29968
Log:
[svn-upgrade] Integrating new upstream version, libarchive-tar-perl (1.44)
Modified:
branches/upstream/libarchive-tar-perl/current/CHANGES
branches/upstream/libarchive-tar-perl/current/META.yml
branches/upstream/libarchive-tar-perl/current/Makefile.PL
branches/upstream/libarchive-tar-perl/current/lib/Archive/Tar.pm
branches/upstream/libarchive-tar-perl/current/t/02_methods.t
Modified: branches/upstream/libarchive-tar-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-tar-perl/current/CHANGES?rev=29968&op=diff
==============================================================================
--- branches/upstream/libarchive-tar-perl/current/CHANGES (original)
+++ branches/upstream/libarchive-tar-perl/current/CHANGES Sat Jan 24 01:12:25 2009
@@ -1,3 +1,8 @@
+* important changes in version 1.44 19/01/2009:
+- Address #41798: Nonempty $\ when writing a Tar file produces a
+ corrupt Tar file
+- Textual fix to Makefile.PL diagnostics
+
* important changes in version 1.42 13/12/2008:
- Address #40426: Archive Tar to support direct Archive::Tar::File adds
It is now possible to add Archive::Tar::File objects via $tar->add_files
Modified: branches/upstream/libarchive-tar-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-tar-perl/current/META.yml?rev=29968&op=diff
==============================================================================
--- branches/upstream/libarchive-tar-perl/current/META.yml (original)
+++ branches/upstream/libarchive-tar-perl/current/META.yml Sat Jan 24 01:12:25 2009
@@ -1,19 +1,28 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Archive-Tar
-version: 1.42
-version_from: lib/Archive/Tar.pm
-installdirs: site
+--- #YAML:1.0
+name: Archive-Tar
+version: 1.44
+abstract: Manipulates TAR archives
+author:
+ - Jos Boumans <kane[at]cpan.org>
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
requires:
- Compress::Zlib: 2.012
- File::Spec: 0.82
- IO::Compress::Base: 2.012
- IO::Compress::Bzip2: 2.012
- IO::Compress::Gzip: 2.012
- IO::Zlib: 1.01
- Package::Constants: 0
- Test::Harness: 2.26
- Test::More: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+ Compress::Zlib: 2.012
+ File::Spec: 0.82
+ IO::Compress::Base: 2.012
+ IO::Compress::Bzip2: 2.012
+ IO::Compress::Gzip: 2.012
+ IO::Zlib: 1.01
+ Package::Constants: 0
+ Test::Harness: 2.26
+ Test::More: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.48
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libarchive-tar-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-tar-perl/current/Makefile.PL?rev=29968&op=diff
==============================================================================
--- branches/upstream/libarchive-tar-perl/current/Makefile.PL (original)
+++ branches/upstream/libarchive-tar-perl/current/Makefile.PL Sat Jan 24 01:12:25 2009
@@ -11,7 +11,7 @@
if( !eval { require IO::Compress::Bzip2; 1 } and !$opt->{n} ) {
warn qq[You do not have IO::Compress::Bzip2 installed. This means you can ].
- qq[not read or write compressed archive!\n] .
+ qq[not read or write bzip2 compressed archives!\n] .
qq[Note: you can disable this warning (and the prerequisite) ].
qq[by invoking Makefile.PL with '-n'\n];
}
@@ -22,14 +22,14 @@
qq[utility requires you to have Text::Diff installed.\n\n].
qq[To add Text::Diff as a prerequisite, please supply the ].
qq['-d' option when invoking this Makefile.PL.\n\n];
-}
+}
my $prereqs = {
- 'Test::More' => 0,
+ 'Test::More' => 0,
'Package::Constants' => 0,
'File::Spec' => 0.82,
'Test::Harness' => 2.26, # bug in older versions
- 'IO::Zlib' => 1.01,
+ 'IO::Zlib' => 1.01,
# All these should be the same version, or breakage may occurr. See:
# http://www.nntp.perl.org/group/perl.cpan.testers/2008/08/msg2083310.html
'IO::Compress::Base' => 2.012, # base class
@@ -37,7 +37,7 @@
'IO::Compress::Gzip' => 2.012, # c::z needs this
'IO::Compress::Bzip2' => 2.012, # bzip2 support
};
-
+
unless ($Config{useperlio}) {
$prereqs->{'IO::String'} = 0; # for better 'return stringified archive'
@@ -48,7 +48,7 @@
### so you want text::diff ###
$prereqs->{'Text::Diff'} = 0 if $opt->{d};
-
+
WriteMakefile (
NAME => 'Archive::Tar',
@@ -59,4 +59,4 @@
INSTALLDIRS => ( $] >= 5.009003 ? 'perl' : 'site' ),
AUTHOR => 'Jos Boumans <kane[at]cpan.org>',
ABSTRACT => 'Manipulates TAR archives'
-);
+);
Modified: branches/upstream/libarchive-tar-perl/current/lib/Archive/Tar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-tar-perl/current/lib/Archive/Tar.pm?rev=29968&op=diff
==============================================================================
--- branches/upstream/libarchive-tar-perl/current/lib/Archive/Tar.pm (original)
+++ branches/upstream/libarchive-tar-perl/current/lib/Archive/Tar.pm Sat Jan 24 01:12:25 2009
@@ -31,7 +31,7 @@
$DEBUG = 0;
$WARN = 1;
$FOLLOW_SYMLINK = 0;
-$VERSION = "1.42";
+$VERSION = "1.44";
$CHOWN = 1;
$CHMOD = 1;
$DO_NOT_USE_PREFIX = 0;
@@ -136,7 +136,7 @@
The C<read> will I<replace> any previous content in C<$tar>!
-The second argument may be considered optional, but remains for
+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.
@@ -171,7 +171,7 @@
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. This means no C<Archive::Tar::File> objects are
+straight to disk. This means no C<Archive::Tar::File> objects are
created for you to inspect.
=back
@@ -226,10 +226,10 @@
$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 );
+ sysread( $tmp, $magic, 4 );
close $tmp;
}
@@ -237,11 +237,11 @@
### 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
+ ($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 {
@@ -250,7 +250,7 @@
);
return;
};
-
+
} else {
$fh = IO::Compress::Bzip2->new( $file ) or do {
$self->_error( qq[Could not write to '$file': ] .
@@ -259,13 +259,13 @@
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;
@@ -273,7 +273,7 @@
$self->_error(qq[Could not create filehandle for '$file': $!]);
return;
}
-
+
### is it plain tar?
} else {
$fh = IO::File->new;
@@ -285,7 +285,7 @@
### enable bin mode on tar archives
binmode $fh;
- }
+ }
}
return $fh;
@@ -351,9 +351,9 @@
my $entry;
{ my %extra_args = ();
$extra_args{'name'} = $$real_name if defined $real_name;
-
- unless( $entry = Archive::Tar::File->new( chunk => $chunk,
- %extra_args )
+
+ unless( $entry = Archive::Tar::File->new( chunk => $chunk,
+ %extra_args )
) {
$self->_error( qq[Couldn't read chunk at offset $offset] );
next LOOP;
@@ -437,14 +437,14 @@
### 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
+ ### 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
@@ -483,7 +483,7 @@
sub contains_file {
my $self = shift;
my $full = shift;
-
+
return unless defined $full;
### don't warn if the entry isn't there.. that's what this function
@@ -522,7 +522,7 @@
### you requested the extraction of only certian files
if( @args ) {
for my $file ( @args ) {
-
+
### it's already an object?
if( UNIVERSAL::isa( $file, 'Archive::Tar::File' ) ) {
push @files, $file;
@@ -530,18 +530,18 @@
### go find it then
} else {
-
+
my $found;
for my $entry ( @{$self->_data} ) {
next unless $file eq $entry->full_path;
-
+
### we found the file you're looking for
push @files, $entry;
$found++;
}
-
+
unless( $found ) {
- return $self->_error(
+ return $self->_error(
qq[Could not find '$file' in archive] );
}
}
@@ -622,20 +622,20 @@
### absolute names are not allowed to be in tarballs under
### strict mode, so only allow it if a user tells us to do it
if( not defined $alt and not $INSECURE_EXTRACT_MODE ) {
- $self->_error(
+ $self->_error(
q[Entry ']. $entry->full_path .q[' is an absolute path. ].
q[Not extracting absolute paths under SECURE EXTRACT MODE]
- );
+ );
return;
}
-
+
### user asked us to, it's fine.
$dir = File::Spec->catpath( $vol, $dirs, "" );
### it's a relative path ###
} else {
- my $cwd = (ref $self and defined $self->{cwd})
- ? $self->{cwd}
+ my $cwd = (ref $self and defined $self->{cwd})
+ ? $self->{cwd}
: cwd();
my @dirs = defined $alt
@@ -643,22 +643,22 @@
: File::Spec::Unix->splitdir( $dirs ); # it's UNIX-style, likely
# straight from the tarball
- if( not defined $alt and
- not $INSECURE_EXTRACT_MODE
- ) {
+ if( not defined $alt and
+ 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
@@ -667,7 +667,7 @@
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};
@@ -683,7 +683,7 @@
);
return;
}
-
+
### XXX keep a cache if possible, so the stats become cheaper:
$self->{_link_cache}->{$full_path} = 1 if ref $self;
}
@@ -693,16 +693,16 @@
### or changed to '_' on vms. vmsify is used, because older versions
### of vmspath do not handle this properly.
### Must not add a '/' to an empty directory though.
- map { length() ? VMS::Filespec::vmsify($_.'/') : $_ } @dirs if ON_VMS;
-
- my ($cwd_vol,$cwd_dir,$cwd_file)
+ map { length() ? VMS::Filespec::vmsify($_.'/') : $_ } @dirs if ON_VMS;
+
+ my ($cwd_vol,$cwd_dir,$cwd_file)
= File::Spec->splitpath( $cwd );
my @cwd = File::Spec->splitdir( $cwd_dir );
push @cwd, $cwd_file if length $cwd_file;
### We need to pass '' as the last elemant to catpath. Craig Berry
### explains why (msgid <p0624083dc311ae541393@[172.16.52.1]>):
- ### The root problem is that splitpath on UNIX always returns the
+ ### The root problem is that splitpath on UNIX always returns the
### final path element as a file even if it is a directory, and of
### course there is no way it can know the difference without checking
### against the filesystem, which it is documented as not doing. When
@@ -711,11 +711,11 @@
### know the result should be a directory. I had thought you could omit
### the file argument to catpath in such a case, but apparently on UNIX
### you can't.
- $dir = File::Spec->catpath(
- $cwd_vol, File::Spec->catdir( @cwd, @dirs ), ''
+ $dir = File::Spec->catpath(
+ $cwd_vol, File::Spec->catdir( @cwd, @dirs ), ''
);
- ### catdir() returns undef if the path is longer than 255 chars on
+ ### catdir() returns undef if the path is longer than 255 chars on
### older VMS systems.
unless ( defined $dir ) {
$^W && $self->_error( qq[Could not compose a path for '$dirs'\n] );
@@ -736,7 +736,7 @@
$self->_error(qq[Could not create directory '$dir' for '$fp': $@]);
return;
}
-
+
### XXX chown here? that might not be the same as in the archive
### as we're only chown'ing to the owner of the file we're extracting
### not to the owner of the directory itself, which may or may not
@@ -1065,17 +1065,17 @@
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).
-
-The second argument is used to indicate compression. You can either
+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
+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
+ # write a bzip compressed file
$tar->write( 'out.tbz', COMPRESSION_BZIP );
Note that when you pass in a filehandle, the compression argument
@@ -1101,16 +1101,19 @@
my $gzip = shift || 0;
my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix;
my $dummy = '';
-
+
### only need a handle if we have a file to print to ###
my $handle = length($file)
? ( $self->_get_handle($file, $gzip, WRITE_ONLY->($gzip) )
or return )
: $HAS_PERLIO ? do { open my $h, '>', \$dummy; $h }
- : $HAS_IO_STRING ? IO::String->new
+ : $HAS_IO_STRING ? IO::String->new
: __PACKAGE__->no_string_support();
-
+ ### Addresses: #41798: Nonempty $\ when writing a TAR file produces a
+ ### corrupt TAR file. Must clear out $\ to make sure no garbage is
+ ### printed to the archive
+ local $\;
for my $entry ( @{$self->_data} ) {
### entries to be written to the tarfile ###
@@ -1122,7 +1125,7 @@
my $clone = $entry->clone;
- ### so, if you don't want use to use the prefix, we'll stuff
+ ### so, if you don't want use to use the prefix, we'll stuff
### everything in the name field instead
if( $DO_NOT_USE_PREFIX ) {
@@ -1229,7 +1232,7 @@
### make sure to close the handle;
close $handle;
-
+
return $rv;
}
@@ -1319,10 +1322,10 @@
### clone it so we don't accidentally have a reference to
### an object from another archive
if( UNIVERSAL::isa( $file,'Archive::Tar::File' ) ) {
- push @rv, $file->clone;
+ push @rv, $file->clone;
next;
}
-
+
unless( -e $file || -l $file ) {
$self->_error( qq[No such file: '$file'] );
next;
@@ -1449,9 +1452,9 @@
=head2 $tar->setcwd( $cwd );
C<Archive::Tar> needs to know the current directory, and it will run
-C<Cwd::cwd()> I<every> time it extracts a I<relative> entry from the
+C<Cwd::cwd()> I<every> time it extracts a I<relative> entry from the
tarfile and saves it in the file system. (As of version 1.30, however,
-C<Archive::Tar> will use the speed optimization described below
+C<Archive::Tar> will use the speed optimization described below
automatically, so it's only relevant if you're using C<extract_file()>).
Since C<Archive::Tar> doesn't change the current directory internally
@@ -1466,7 +1469,7 @@
once before calling a function like C<extract_file> and
C<Archive::Tar> will use the current directory setting from then on
-and won't call C<Cwd::cwd()> internally.
+and won't call C<Cwd::cwd()> internally.
To switch back to the default behaviour, use
@@ -1477,7 +1480,7 @@
If you're using C<Archive::Tar>'s C<exract()> method, C<setcwd()> will
be called for you.
-=cut
+=cut
sub setcwd {
my $self = shift;
@@ -1494,15 +1497,15 @@
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 is used to indicate compression. You can either
+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
+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
+ # 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
@@ -1559,7 +1562,7 @@
print $f->name, "\n";
$f->extract or warn "Extraction failed";
-
+
# ....
}
@@ -1574,8 +1577,8 @@
### get a handle to read from.
my $handle = $class->_get_handle(
- $filename,
- $compressed,
+ $filename,
+ $compressed,
READ_ONLY->( ZLIB )
) or return;
@@ -1589,7 +1592,7 @@
### return one piece of data
return shift(@data) if @data;
-
+
### data is exhausted, free the filehandle
undef $handle;
return;
@@ -1605,7 +1608,7 @@
If C<list_archive()> is passed an array reference as its third
argument it returns a list of hash references containing the requested
properties of each file. The following list of properties is
-supported: full_path, name, size, mtime (last modified date), mode,
+supported: full_path, name, size, mtime (last modified date), mode,
uid, gid, linkname, uname, gname, devmajor, devminor, prefix.
See C<Archive::Tar::File> for details about supported properties.
@@ -1655,7 +1658,7 @@
Returns true if we currently have C<IO::String> support loaded.
-Either C<IO::String> or C<perlio> support is needed to support writing
+Either C<IO::String> or C<perlio> support is needed to support writing
stringified archives. Currently, C<perlio> is the preferred method, if
available.
@@ -1669,9 +1672,9 @@
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
+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.
@@ -1753,13 +1756,13 @@
=head2 $Archive::Tar::DO_NOT_USE_PREFIX
-By default, C<Archive::Tar> will try to put paths that are over
+By default, C<Archive::Tar> will try to put paths that are over
100 characters in the C<prefix> field of your tar header, as
-defined per POSIX-standard. However, some (older) tar programs
-do not implement this spec. To retain compatibility with these older
-or non-POSIX compliant versions, you can set the C<$DO_NOT_USE_PREFIX>
-variable to a true value, and C<Archive::Tar> will use an alternate
-way of dealing with paths over 100 characters by using the
+defined per POSIX-standard. However, some (older) tar programs
+do not implement this spec. To retain compatibility with these older
+or non-POSIX compliant versions, you can set the C<$DO_NOT_USE_PREFIX>
+variable to a true value, and C<Archive::Tar> will use an alternate
+way of dealing with paths over 100 characters by using the
C<GNU Extended Header> feature.
Note that clients who do not support the C<GNU Extended Header>
@@ -1800,11 +1803,11 @@
Allowing this could have security implications, as a malicious
tar archive could alter or replace any file the extracting user
-has permissions to. Therefor, the default is to not allow
-insecure extractions.
-
-If you trust the archive, or have other reasons to allow the
-archive to write files outside your current working directory,
+has permissions to. Therefor, the default is to not allow
+insecure extractions.
+
+If you trust the archive, or have other reasons to allow the
+archive to write files outside your current working directory,
set this variable to C<true>.
Note that this is a backwards incompatible change from version
@@ -1812,9 +1815,9 @@
=head2 $Archive::Tar::HAS_PERLIO
-This variable holds a boolean indicating if we currently have
+This variable holds a boolean indicating if we currently have
C<perlio> support loaded. This will be enabled for any perl
-greater than C<5.8> compiled with C<perlio>.
+greater than C<5.8> compiled with C<perlio>.
If you feel strongly about disabling it, set this variable to
C<false>. Note that you will then need C<IO::String> installed
@@ -1825,7 +1828,7 @@
=head2 $Archive::Tar::HAS_IO_STRING
-This variable holds a boolean indicating if we currently have
+This variable holds a boolean indicating if we currently have
C<IO::String> support loaded. This will be enabled for any perl
that has a loadable C<IO::String> module.
@@ -1872,7 +1875,7 @@
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 the C<iter> class method, or C</bin/tar>
+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?
@@ -1883,8 +1886,8 @@
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, including C<iter>
-on archives that have incompatible filetypes and still expect things
+(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
@@ -1898,7 +1901,7 @@
C<POSIX header prefix>. Non-POSIX-compatible clients may not support
this part of the specification, and may only support the C<GNU Extended
Header> functionality. To facilitate those clients, you can set the
-C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. See the
+C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. See the
C<GLOBAL VARIABLES> section for details on this variable.
Note that GNU tar earlier than version 1.14 does not cope well with
@@ -1914,9 +1917,9 @@
based on your criteria. For example, to extract only files that have
the string C<foo> in their title, you would use:
- $tar->extract(
+ $tar->extract(
grep { $_->full_path =~ /foo/ } $tar->get_files
- );
+ );
This way, you can filter on any attribute of the files in the archive.
Consult the C<Archive::Tar::File> documentation on how to use these
@@ -1993,22 +1996,22 @@
$tar->add_data('file.txt', $data);
-A opposite problem occurs if you extract a UTF8-encoded file from a
+A opposite problem occurs if you extract a UTF8-encoded file from a
tarball. Using C<get_content()> on the C<Archive::Tar::File> object
will return its content as a bytestring, not as a Unicode string.
If you want it to be a Unicode string (because you want character
semantics with operations like regular expression matching), you need
-to decode the UTF8-encoded content and have Perl convert it into
+to decode the UTF8-encoded content and have Perl convert it into
a Unicode string:
use Encode;
my $data = $tar->get_content();
-
+
# Make it a Unicode string
$data = decode('utf8', $data);
-There is no easy way to provide this functionality in C<Archive::Tar>,
+There is no easy way to provide this functionality in C<Archive::Tar>,
because a tarball can contain many files, and each of which could be
encoded in a different way.
@@ -2075,10 +2078,10 @@
=head1 COPYRIGHT
-This module is copyright (c) 2002 - 2008 Jos Boumans
+This module is copyright (c) 2002 - 2008 Jos Boumans
E<lt>kane at cpan.orgE<gt>. All rights reserved.
-This library is free software; you may redistribute and/or modify
+This library is free software; you may redistribute and/or modify
it under the same terms as Perl itself.
=cut
Modified: branches/upstream/libarchive-tar-perl/current/t/02_methods.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-tar-perl/current/t/02_methods.t?rev=29968&op=diff
==============================================================================
--- branches/upstream/libarchive-tar-perl/current/t/02_methods.t (original)
+++ branches/upstream/libarchive-tar-perl/current/t/02_methods.t Sat Jan 24 01:12:25 2009
@@ -1,7 +1,7 @@
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
- }
+ }
use lib '../../..';
}
@@ -80,7 +80,7 @@
my @ROOT = grep { length } 'src', $TOO_LONG ? 'short' : 'long';
my $NO_UNLINK = $ARGV[0] ? 1 : 0;
-### enable debugging?
+### enable debugging?
### pesky warnings
$Archive::Tar::DEBUG = $Archive::Tar::DEBUG = 1 if $ARGV[1];
@@ -107,7 +107,7 @@
{ for my $meth ( qw[has_zlib_support has_bzip2_support] ) {
can_ok( $Class, $meth );
}
-}
+}
@@ -142,18 +142,18 @@
### check if ->error eq $error
is( $tar->error, $Archive::Tar::error,
"Error '$Archive::Tar::error' matches $Class->error method" );
-
- ### check that 'contains_file' doesn't warn about missing files.
+
+ ### check that 'contains_file' doesn't warn about missing files.
{ ### turn on warnings in general!
local $Archive::Tar::WARN = 1;
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
+
my $rv = $tar->contains_file( $$ );
ok( !$rv, "Does not contain file '$$'" );
is( $warnings, '', " No warnings issued during lookup" );
- }
+ }
}
### read tests ###
@@ -188,7 +188,7 @@
is( $tar->_find_entry( $test ), $file,
" Found proper object" );
}
-
+
next unless $file->is_file;
my $name = $file->full_path;
@@ -244,7 +244,7 @@
skip( "You are building perl using symlinks", 1)
if ($ENV{PERL_CORE} and $Config{config_args} =~/Dmksymlinks/);
- is( $files[0]->is_file, 1,
+ is( $files[0]->is_file, 1,
" Proper type" );
}
@@ -275,22 +275,22 @@
" Adding dirs");
ok( $dirs[0]->is_dir, " Proper type" );
}
-
+
### check if we can add a A::T::File object
{ my $tar2 = $Class->new;
my($added) = $tar2->add_files( $add[0] );
-
+
ok( $added, " Added a file '$add[0]' to new object" );
- isa_ok( $added, $FClass, " Object" );
+ isa_ok( $added, $FClass, " Object" );
my($added2) = $tar2->add_files( $added );
ok( $added2, " Added an $FClass object" );
- isa_ok( $added2, $FClass, " Object" );
-
+ isa_ok( $added2, $FClass, " Object" );
+
is_deeply( [$added, $added2], [$tar2->get_files],
" All files accounted for" );
isnt( $added, $added2, " Different memory allocations" );
- }
+ }
}
### add data tests ###
@@ -389,11 +389,11 @@
### write + read + extract tests ###
SKIP: { ### pesky warnings
- skip('no IO::String', 326) if !$Archive::Tar::HAS_PERLIO &&
- !$Archive::Tar::HAS_PERLIO &&
+ 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 = $Class->new;
my $new = $Class->new;
ok( $tar->read( $TAR_FILE ), "Read in '$TAR_FILE'" );
@@ -414,6 +414,11 @@
### write tar tests
{ my $out = $OUT_TAR_FILE;
+ ### bug #41798: 'Nonempty $\ when writing a TAR file produces a
+ ### corrupt TAR file' shows that setting $\ breaks writing tar files
+ ### set it here purposely so we can verify NOTHING breaks
+ local $\ = 'FOOBAR';
+
{ ### write()
ok( $obj->write($out),
" Wrote tarfile using 'write'" );
@@ -450,7 +455,7 @@
{ my @out;
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 ) {
my( $out, $compression ) = @$entry;
@@ -732,22 +737,22 @@
close $fh;
$NO_UNLINK or 1 while unlink $path;
- ### alternate extract path tests
+ ### alternate extract path tests
### to abs and rel paths
{ for my $outpath ( File::Spec->catdir( @ROOT ),
- File::Spec->rel2abs(
+ 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;
- }
+ }
}
}
@@ -773,11 +778,11 @@
sub slurp_compressed_file {
my $file = shift;
my $fh;
-
+
### bzip2
if( $file =~ /.tbz$/ ) {
require IO::Uncompress::Bunzip2;
- $fh = IO::Uncompress::Bunzip2->new( $file )
+ $fh = IO::Uncompress::Bunzip2->new( $file )
or warn( "Error opening '$file' with IO::Uncompress::Bunzip2" ), return
### gzip
@@ -786,7 +791,7 @@
$fh = new IO::Zlib;
$fh->open( $file, READ_ONLY->(1) )
or warn( "Error opening '$file' with IO::Zlib" ), return
- }
+ }
my $str;
my $buff;
More information about the Pkg-perl-cvs-commits
mailing list