From: Jos I. Boumans Date: Fri, 26 Jan 2007 15:02:36 +0000 (+0100) Subject: Add Archive::Extract 0.16 to the core X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=520c99e2af40711b1b614f245b1d24dd5d1bde96;hp=404c68920bc89ad702536fbd16b3bceafd287acb;p=p5sagit%2Fp5-mst-13.2.git Add Archive::Extract 0.16 to the core From: "Jos Boumans" Message-ID: <21170.80.127.35.68.1169820156.squirrel@webmail.xs4all.nl> p4raw-id: //depot/perl@30012 --- diff --git a/MANIFEST b/MANIFEST index 0ad36c9..5ba407d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1369,6 +1369,25 @@ keywords.pl Program to write keywords.h lib/abbrev.pl An abbreviation table builder lib/AnyDBM_File.pm Perl module to emulate dbmopen lib/AnyDBM_File.t See if AnyDBM_File works +lib/Archive/Extract.pm Archive::Extract +lib/Archive/Extract/t/01_Archive-Extract.t Archive::Extract tests +lib/Archive/Extract/t/src/double_dir.zip.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.bz2.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.gz.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.jar.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.par.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.tar.gz.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.tar.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.tgz.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.zip.packed Archive::Extract tests +lib/Archive/Extract/t/src/y.jar.packed Archive::Extract tests +lib/Archive/Extract/t/src/y.par.packed Archive::Extract tests +lib/Archive/Extract/t/src/y.tar.bz2.packed Archive::Extract tests +lib/Archive/Extract/t/src/y.tar.gz.packed Archive::Extract tests +lib/Archive/Extract/t/src/y.tar.packed Archive::Extract tests +lib/Archive/Extract/t/src/y.tbz.packed Archive::Extract tests +lib/Archive/Extract/t/src/y.tgz.packed Archive::Extract tests +lib/Archive/Extract/t/src/y.zip.packed Archive::Extract tests lib/Archive/Tar/bin/ptar the ptar utility lib/Archive/Tar/bin/ptardiff the ptardiff utility lib/Archive/Tar/Constant.pm Archive::Tar diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm new file mode 100644 index 0000000..678489a --- /dev/null +++ b/lib/Archive/Extract.pm @@ -0,0 +1,1145 @@ +package Archive::Extract; + +use strict; + +use Cwd qw[cwd]; +use Carp qw[carp]; +use IPC::Cmd qw[run can_run]; +use FileHandle; +use File::Path qw[mkpath]; +use File::Spec; +use File::Basename qw[dirname basename]; +use Params::Check qw[check]; +use Module::Load::Conditional qw[can_load check_install]; +use Locale::Maketext::Simple Style => 'gettext'; + +### solaris has silly /bin/tar output ### +use constant ON_SOLARIS => $^O eq 'solaris' ? 1 : 0; +use constant FILE_EXISTS => sub { -e $_[0] ? 1 : 0 }; + +### If these are changed, update @TYPES and the new() POD +use constant TGZ => 'tgz'; +use constant TAR => 'tar'; +use constant GZ => 'gz'; +use constant ZIP => 'zip'; +use constant BZ2 => 'bz2'; +use constant TBZ => 'tbz'; + +use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG]; + +$VERSION = '0.16'; +$PREFER_BIN = 0; +$WARN = 1; +$DEBUG = 0; +my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ ); # same as all constants + +local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1; + +=pod + +=head1 NAME + +Archive::Extract - A generic archive extracting mechanism + +=head1 SYNOPSIS + + use Archive::Extract; + + ### build an Archive::Extract object ### + my $ae = Archive::Extract->new( archive => 'foo.tgz' ); + + ### extract to cwd() ### + my $ok = $ae->extract; + + ### extract to /tmp ### + my $ok = $ae->extract( to => '/tmp' ); + + ### what if something went wrong? + my $ok = $ae->extract or die $ae->error; + + ### files from the archive ### + my $files = $ae->files; + + ### dir that was extracted to ### + my $outdir = $ae->extract_path; + + + ### quick check methods ### + $ae->is_tar # is it a .tar file? + $ae->is_tgz # is it a .tar.gz or .tgz file? + $ae->is_gz; # is it a .gz file? + $ae->is_zip; # is it a .zip file? + $ae->is_bz2; # is it a .bz2 file? + $ae->is_tbz; # is it a .tar.bz2 or .tbz file? + + ### absolute path to the archive you provided ### + $ae->archive; + + ### commandline tools, if found ### + $ae->bin_tar # path to /bin/tar, if found + $ae->bin_gzip # path to /bin/gzip, if found + $ae->bin_unzip # path to /bin/unzip, if found + $ae->bin_bunzip2 # path to /bin/bunzip2 if found + +=head1 DESCRIPTION + +Archive::Extract is a generic archive extraction mechanism. + +It allows you to extract any archive file of the type .tar, .tar.gz, +.gz, tar.bz2, .tbz, .bz2 or .zip without having to worry how it does +so, or use different interfaces for each type by using either perl +modules, or commandline tools on your system. + +See the C section further down for details. + +=cut + + +### see what /bin/programs are available ### +$PROGRAMS = {}; +for my $pgm (qw[tar unzip gzip bunzip2]) { + $PROGRAMS->{$pgm} = can_run($pgm); +} + +### mapping from types to extractor methods ### +my $Mapping = { + is_tgz => '_untar', + is_tar => '_untar', + is_gz => '_gunzip', + is_zip => '_unzip', + is_tbz => '_untar', + is_bz2 => '_bunzip2', +}; + +{ + my $tmpl = { + archive => { required => 1, allow => FILE_EXISTS }, + type => { default => '', allow => [ @Types ] }, + }; + + ### build accesssors ### + for my $method( keys %$tmpl, + qw[_extractor _gunzip_to files extract_path], + qw[_error_msg _error_msg_long] + ) { + no strict 'refs'; + *$method = sub { + my $self = shift; + $self->{$method} = $_[0] if @_; + return $self->{$method}; + } + } + +=head1 METHODS + +=head2 $ae = Archive::Extract->new(archive => '/path/to/archive',[type => TYPE]) + +Creates a new C object based on the archive file you +passed it. Automatically determines the type of archive based on the +extension, but you can override that by explicitly providing the +C argument. + +Valid values for C are: + +=over 4 + +=item tar + +Standard tar files, as produced by, for example, C. +Corresponds to a C<.tar> suffix. + +=item tgz + +Gzip compressed tar files, as produced by, for example C. +Corresponds to a C<.tgz> or C<.tar.gz> suffix. + +=item gz + +Gzip compressed file, as produced by, for example C. +Corresponds to a C<.gz> suffix. + +=item zip + +Zip compressed file, as produced by, for example C. +Corresponds to a C<.zip>, C<.jar> or C<.par> suffix. + +=item bz2 + +Bzip2 compressed file, as produced by, for example, C. +Corresponds to a C<.bz2> suffix. + +=item tbz + +Bzip2 compressed tar file, as produced by, for exmample C. +Corresponds to a C<.tbz> or C<.tar.bz2> suffix. + +=back + +Returns a C object on success, or false on failure. + +=cut + + ### constructor ### + sub new { + my $class = shift; + my %hash = @_; + + my $parsed = check( $tmpl, \%hash ) or return; + + ### make sure we have an absolute path ### + my $ar = $parsed->{archive} = File::Spec->rel2abs( $parsed->{archive} ); + + ### figure out the type, if it wasn't already specified ### + unless ( $parsed->{type} ) { + $parsed->{type} = + $ar =~ /.+?\.(?:tar\.gz)|tgz$/i ? TGZ : + $ar =~ /.+?\.gz$/i ? GZ : + $ar =~ /.+?\.tar$/i ? TAR : + $ar =~ /.+?\.(zip|jar|par)$/i ? ZIP : + $ar =~ /.+?\.(?:tbz|tar\.bz2?)$/i ? TBZ : + $ar =~ /.+?\.bz2$/i ? BZ2 : + ''; + + } + + ### don't know what type of file it is ### + return __PACKAGE__->_error(loc("Cannot determine file type for '%1'", + $parsed->{archive} )) unless $parsed->{type}; + + return bless $parsed, $class; + } +} + +=head2 $ae->extract( [to => '/output/path'] ) + +Extracts the archive represented by the C object to +the path of your choice as specified by the C argument. Defaults to +C. + +Since C<.gz> files never hold a directory, but only a single file; if +the C argument is an existing directory, the file is extracted +there, with it's C<.gz> suffix stripped. +If the C argument is not an existing directory, the C argument +is understood to be a filename, if the archive type is C. +In the case that you did not specify a C argument, the output +file will be the name of the archive file, stripped from it's C<.gz> +suffix, in the current working directory. + +C will try a pure perl solution first, and then fall back to +commandline tools if they are available. See the C +section below on how to alter this behaviour. + +It will return true on success, and false on failure. + +On success, it will also set the follow attributes in the object: + +=over 4 + +=item $ae->extract_path + +This is the directory that the files where extracted to. + +=item $ae->files + +This is an array ref with the paths of all the files in the archive, +relative to the C argument you specified. +To get the full path to an extracted file, you would use: + + File::Spec->catfile( $to, $ae->files->[0] ); + +Note that all files from a tar archive will be in unix format, as per +the tar specification. + +=back + +=cut + +sub extract { + my $self = shift; + my %hash = @_; + + my $to; + my $tmpl = { + to => { default => '.', store => \$to } + }; + + check( $tmpl, \%hash ) or return; + + ### so 'to' could be a file or a dir, depending on whether it's a .gz + ### file, or basically anything else. + ### so, check that, then act accordingly. + ### set an accessor specifically so _gunzip can know what file to extract + ### to. + my $dir; + { ### a foo.gz file + if( $self->is_gz or $self->is_bz2 ) { + + my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2)$//i; + + ### to is a dir? + if ( -d $to ) { + $dir = $to; + $self->_gunzip_to( basename($cp) ); + + ### then it's a filename + } else { + $dir = dirname($to); + $self->_gunzip_to( basename($to) ); + } + + ### not a foo.gz file + } else { + $dir = $to; + } + } + + ### make the dir if it doesn't exist ### + unless( -d $dir ) { + eval { mkpath( $dir ) }; + + return $self->_error(loc("Could not create path '%1': %2", $dir, $@)) + if $@; + } + + ### get the current dir, to restore later ### + my $cwd = cwd(); + + my $ok = 1; + EXTRACT: { + + ### chdir to the target dir ### + unless( chdir $dir ) { + $self->_error(loc("Could not chdir to '%1': %2", $dir, $!)); + $ok = 0; last EXTRACT; + } + + ### set files to an empty array ref, so there's always an array + ### ref IN the accessor, to avoid errors like: + ### Can't use an undefined value as an ARRAY reference at + ### ../lib/Archive/Extract.pm line 742. (rt #19815) + $self->files( [] ); + + ### find what extractor method to use ### + while( my($type,$method) = each %$Mapping ) { + + ### call the corresponding method if the type is OK ### + if( $self->$type) { + $ok = $self->$method(); + } + } + + ### warn something went wrong if we didn't get an OK ### + $self->_error(loc("Extract failed, no extractor found")) + unless $ok; + + } + + ### and chdir back ### + unless( chdir $cwd ) { + $self->_error(loc("Could not chdir back to start dir '%1': %2'", + $cwd, $!)); + } + + return $ok; +} + +=pod + +=head1 ACCESSORS + +=head2 $ae->error([BOOL]) + +Returns the last encountered error as string. +Pass it a true value to get the C output instead. + +=head2 $ae->extract_path + +This is the directory the archive got extracted to. +See C for details. + +=head2 $ae->files + +This is an array ref holding all the paths from the archive. +See C for details. + +=head2 $ae->archive + +This is the full path to the archive file represented by this +C object. + +=head2 $ae->type + +This is the type of archive represented by this C +object. See accessors below for an easier way to use this. +See the C method for details. + +=head2 $ae->types + +Returns a list of all known C for C's +C method. + +=cut + +sub types { return @Types } + +=head2 $ae->is_tgz + +Returns true if the file is of type C<.tar.gz>. +See the C method for details. + +=head2 $ae->is_tar + +Returns true if the file is of type C<.tar>. +See the C method for details. + +=head2 $ae->is_gz + +Returns true if the file is of type C<.gz>. +See the C method for details. + +=head2 $ae->is_zip + +Returns true if the file is of type C<.zip>. +See the C method for details. + +=cut + +### quick check methods ### +sub is_tgz { return $_[0]->type eq TGZ } +sub is_tar { return $_[0]->type eq TAR } +sub is_gz { return $_[0]->type eq GZ } +sub is_zip { return $_[0]->type eq ZIP } +sub is_tbz { return $_[0]->type eq TBZ } +sub is_bz2 { return $_[0]->type eq BZ2 } + +=pod + +=head2 $ae->bin_tar + +Returns the full path to your tar binary, if found. + +=head2 $ae->bin_gzip + +Returns the full path to your gzip binary, if found + +=head2 $ae->bin_unzip + +Returns the full path to your unzip binary, if found + +=cut + +### paths to commandline tools ### +sub bin_gzip { return $PROGRAMS->{'gzip'} if $PROGRAMS->{'gzip'} } +sub bin_unzip { return $PROGRAMS->{'unzip'} if $PROGRAMS->{'unzip'} } +sub bin_tar { return $PROGRAMS->{'tar'} if $PROGRAMS->{'tar'} } +sub bin_bunzip2 { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} } + +################################# +# +# Untar code +# +################################# + + +### untar wrapper... goes to either Archive::Tar or /bin/tar +### depending on $PREFER_BIN +sub _untar { + my $self = shift; + + ### bzip2 support in A::T via IO::Uncompress::Bzip2 + my @methods = qw[_untar_at _untar_bin]; + @methods = reverse @methods unless $PREFER_BIN; + + for my $method (@methods) { + $self->_extractor($method) && return 1 if $self->$method(); + } + + return $self->_error(loc("Unable to untar file '%1'", $self->archive)); +} + +### use /bin/tar to extract ### +sub _untar_bin { + my $self = shift; + + ### check for /bin/tar ### + return $self->_error(loc("No '%1' program found", '/bin/tar')) + unless $self->bin_tar; + + ### check for /bin/gzip if we need it ### + return $self->_error(loc("No '%1' program found", '/bin/gzip')) + if $self->is_tgz && !$self->bin_gzip; + + return $self->_error(loc("No '%1' program found", '/bin/bunzip2')) + if $self->is_tbz && !$self->bin_bunzip2; + + ### XXX figure out how to make IPC::Run do this in one call -- + ### currently i don't know how to get output of a command after a pipe + ### trapped in a scalar. Mailed barries about this 5th of june 2004. + + + + ### see what command we should run, based on whether + ### it's a .tgz or .tar + + ### XXX solaris tar and bsdtar are having different outputs + ### depending whether you run with -x or -t + ### compensate for this insanity by running -t first, then -x + { my $cmd = + $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|', + $self->bin_tar, '-tf', '-'] : + $self->is_tbz ? [$self->bin_bunzip2, '-c', $self->archive, '|', + $self->bin_tar, '-tf', '-'] : + [$self->bin_tar, '-tf', $self->archive]; + + ### run the command ### + my $buffer = ''; + unless( scalar run( command => $cmd, + buffer => \$buffer, + verbose => $DEBUG ) + ) { + return $self->_error(loc( + "Error listing contents of archive '%1': %2", + $self->archive, $buffer )); + } + + ### no buffers available? + if( !IPC::Cmd->can_capture_buffer and !$buffer ) { + $self->_error( $self->_no_buffer_files( $self->archive ) ); + + } else { + ### if we're on solaris we /might/ be using /bin/tar, which has + ### a weird output format... we might also be using + ### /usr/local/bin/tar, which is gnu tar, which is perfectly + ### fine... so we have to do some guessing here =/ + my @files = map { chomp; + !ON_SOLARIS ? $_ + : (m|^ x \s+ # 'xtract' -- sigh + (.+?), # the actual file name + \s+ [\d,.]+ \s bytes, + \s+ [\d,.]+ \s tape \s blocks + |x ? $1 : $_); + + } split $/, $buffer; + + ### store the files that are in the archive ### + $self->files(\@files); + } + } + + ### now actually extract it ### + { my $cmd = + $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|', + $self->bin_tar, '-xf', '-'] : + $self->is_tbz ? [$self->bin_bunzip2, '-c', $self->archive, '|', + $self->bin_tar, '-xf', '-'] : + [$self->bin_tar, '-xf', $self->archive]; + + my $buffer = ''; + unless( scalar run( command => $cmd, + buffer => \$buffer, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Error extracting archive '%1': %2", + $self->archive, $buffer )); + } + + ### we might not have them, due to lack of buffers + if( $self->files ) { + ### now that we've extracted, figure out where we extracted to + my $dir = $self->__get_extract_dir( $self->files ); + + ### store the extraction dir ### + $self->extract_path( $dir ); + } + } + + ### we got here, no error happened + return 1; +} + +### use archive::tar to extract ### +sub _untar_at { + my $self = shift; + + ### we definitely need A::T, so load that first + { my $use_list = { 'Archive::Tar' => '0.0' }; + + unless( can_load( modules => $use_list ) ) { + + return $self->_error(loc("You do not have '%1' installed - " . + "Please install it as soon as possible.", + 'Archive::Tar')); + } + } + + ### we might pass it a filehandle if it's a .tbz file.. + my $fh_to_read = $self->archive; + + ### we will need Compress::Zlib too, if it's a tgz... and IO::Zlib + ### if A::T's version is 0.99 or higher + if( $self->is_tgz ) { + my $use_list = { 'Compress::Zlib' => '0.0' }; + $use_list->{ 'IO::Zlib' } = '0.0' + if $Archive::Tar::VERSION >= '0.99'; + + unless( can_load( modules => $use_list ) ) { + my $which = join '/', sort keys %$use_list; + + return $self->_error(loc( + "You do not have '%1' installed - Please ". + "install it as soon as possible.", $which)); + + } + } elsif ( $self->is_tbz ) { + my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' }; + unless( can_load( modules => $use_list ) ) { + return $self->_error(loc( + "You do not have '%1' installed - Please " . + "install it as soon as possible.", + 'IO::Uncompress::Bunzip2')); + } + + my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or + return $self->_error(loc("Unable to open '%1': %2", + $self->archive, + $IO::Uncompress::Bunzip2::Bunzip2Error)); + + $fh_to_read = $bz; + } + + my $tar = Archive::Tar->new(); + + ### only tell it it's compressed if it's a .tgz, as we give it a file + ### handle if it's a .tbz + unless( $tar->read( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) ) ) { + return $self->_error(loc("Unable to read '%1': %2", $self->archive, + $Archive::Tar::error)); + } + + ### workaround to prevent Archive::Tar from setting uid, which + ### is a potential security hole. -autrijus + ### have to do it here, since A::T needs to be /loaded/ first ### + { no strict 'refs'; local $^W; + + ### older versions of archive::tar <= 0.23 + *Archive::Tar::chown = sub {}; + } + + ### for version of archive::tar > 1.04 + local $Archive::Tar::Constant::CHOWN = 0; + + { local $^W; # quell 'splice() offset past end of array' warnings + # on older versions of A::T + + ### older archive::tar always returns $self, return value slightly + ### fux0r3d because of it. + $tar->extract() + or return $self->_error(loc("Unable to extract '%1': %2", + $self->archive, $Archive::Tar::error )); + } + + my @files = $tar->list_files; + my $dir = $self->__get_extract_dir( \@files ); + + ### store the files that are in the archive ### + $self->files(\@files); + + ### store the extraction dir ### + $self->extract_path( $dir ); + + ### check if the dir actually appeared ### + return 1 if -d $self->extract_path; + + ### no dir, we failed ### + return $self->_error(loc("Unable to extract '%1': %2", + $self->archive, $Archive::Tar::error )); +} + +################################# +# +# Gunzip code +# +################################# + +### gunzip wrapper... goes to either Compress::Zlib or /bin/gzip +### depending on $PREFER_BIN +sub _gunzip { + my $self = shift; + + my @methods = qw[_gunzip_cz _gunzip_bin]; + @methods = reverse @methods if $PREFER_BIN; + + for my $method (@methods) { + $self->_extractor($method) && return 1 if $self->$method(); + } + + return $self->_error(loc("Unable to gunzip file '%1'", $self->archive)); +} + +sub _gunzip_bin { + my $self = shift; + + ### check for /bin/gzip -- we need it ### + return $self->_error(loc("No '%1' program found", '/bin/gzip')) + unless $self->bin_gzip; + + + my $fh = FileHandle->new('>'. $self->_gunzip_to) or + return $self->_error(loc("Could not open '%1' for writing: %2", + $self->_gunzip_to, $! )); + + my $cmd = [ $self->bin_gzip, '-cdf', $self->archive ]; + + my $buffer; + unless( scalar run( command => $cmd, + verbose => $DEBUG, + buffer => \$buffer ) + ) { + return $self->_error(loc("Unable to gunzip '%1': %2", + $self->archive, $buffer)); + } + + ### no buffers available? + if( !IPC::Cmd->can_capture_buffer and !$buffer ) { + $self->_error( $self->_no_buffer_content( $self->archive ) ); + } + + print $fh $buffer if defined $buffer; + + close $fh; + + ### set what files where extract, and where they went ### + $self->files( [$self->_gunzip_to] ); + $self->extract_path( File::Spec->rel2abs(cwd()) ); + + return 1; +} + +sub _gunzip_cz { + my $self = shift; + + my $use_list = { 'Compress::Zlib' => '0.0' }; + unless( can_load( modules => $use_list ) ) { + return $self->_error(loc("You do not have '%1' installed - Please " . + "install it as soon as possible.", 'Compress::Zlib')); + } + + my $gz = Compress::Zlib::gzopen( $self->archive, "rb" ) or + return $self->_error(loc("Unable to open '%1': %2", + $self->archive, $Compress::Zlib::gzerrno)); + + my $fh = FileHandle->new('>'. $self->_gunzip_to) or + return $self->_error(loc("Could not open '%1' for writing: %2", + $self->_gunzip_to, $! )); + + my $buffer; + $fh->print($buffer) while $gz->gzread($buffer) > 0; + $fh->close; + + ### set what files where extract, and where they went ### + $self->files( [$self->_gunzip_to] ); + $self->extract_path( File::Spec->rel2abs(cwd()) ); + + return 1; +} + +################################# +# +# Unzip code +# +################################# + +### unzip wrapper... goes to either Archive::Zip or /bin/unzip +### depending on $PREFER_BIN +sub _unzip { + my $self = shift; + + my @methods = qw[_unzip_az _unzip_bin]; + @methods = reverse @methods if $PREFER_BIN; + + for my $method (@methods) { + $self->_extractor($method) && return 1 if $self->$method(); + } + + return $self->_error(loc("Unable to gunzip file '%1'", $self->archive)); +} + +sub _unzip_bin { + my $self = shift; + + ### check for /bin/gzip if we need it ### + return $self->_error(loc("No '%1' program found", '/bin/unzip')) + unless $self->bin_unzip; + + + ### first, get the files.. it must be 2 different commands with 'unzip' :( + { my $cmd = [ $self->bin_unzip, '-Z', '-1', $self->archive ]; + + my $buffer = ''; + unless( scalar run( command => $cmd, + verbose => $DEBUG, + buffer => \$buffer ) + ) { + return $self->_error(loc("Unable to unzip '%1': %2", + $self->archive, $buffer)); + } + + ### no buffers available? + if( !IPC::Cmd->can_capture_buffer and !$buffer ) { + $self->_error( $self->_no_buffer_files( $self->archive ) ); + + } else { + $self->files( [split $/, $buffer] ); + } + } + + ### now, extract the archive ### + { my $cmd = [ $self->bin_unzip, '-qq', '-o', $self->archive ]; + + my $buffer; + unless( scalar run( command => $cmd, + verbose => $DEBUG, + buffer => \$buffer ) + ) { + return $self->_error(loc("Unable to unzip '%1': %2", + $self->archive, $buffer)); + } + + if( scalar @{$self->files} ) { + my $files = $self->files; + my $dir = $self->__get_extract_dir( $files ); + + $self->extract_path( $dir ); + } + } + + return 1; +} + +sub _unzip_az { + my $self = shift; + + my $use_list = { 'Archive::Zip' => '0.0' }; + unless( can_load( modules => $use_list ) ) { + return $self->_error(loc("You do not have '%1' installed - Please " . + "install it as soon as possible.", 'Archive::Zip')); + } + + my $zip = Archive::Zip->new(); + + unless( $zip->read( $self->archive ) == &Archive::Zip::AZ_OK ) { + return $self->_error(loc("Unable to read '%1'", $self->archive)); + } + + my @files; + ### have to extract every memeber individually ### + for my $member ($zip->members) { + push @files, $member->{fileName}; + + unless( $zip->extractMember($member) == &Archive::Zip::AZ_OK ) { + return $self->_error(loc("Extraction of '%1' from '%2' failed", + $member->{fileName}, $self->archive )); + } + } + + my $dir = $self->__get_extract_dir( \@files ); + + ### set what files where extract, and where they went ### + $self->files( \@files ); + $self->extract_path( File::Spec->rel2abs($dir) ); + + return 1; +} + +sub __get_extract_dir { + my $self = shift; + my $files = shift || []; + + return unless scalar @$files; + + my($dir1, $dir2); + for my $aref ( [ \$dir1, 0 ], [ \$dir2, -1 ] ) { + my($dir,$pos) = @$aref; + + ### add a catdir(), so that any trailing slashes get + ### take care of (removed) + ### also, a catdir() normalises './dir/foo' to 'dir/foo'; + ### which was the problem in bug #23999 + my $res = -d $files->[$pos] + ? File::Spec->catdir( $files->[$pos], '' ) + : File::Spec->catdir( dirname( $files->[$pos] ) ); + + $$dir = $res; + } + + ### if the first and last dir don't match, make sure the + ### dirname is not set wrongly + my $dir; + + ### dirs are the same, so we know for sure what the extract dir is + if( $dir1 eq $dir2 ) { + $dir = $dir1; + + ### dirs are different.. do they share the base dir? + ### if so, use that, if not, fall back to '.' + } else { + my $base1 = [ File::Spec->splitdir( $dir1 ) ]->[0]; + my $base2 = [ File::Spec->splitdir( $dir2 ) ]->[0]; + + $dir = File::Spec->rel2abs( $base1 eq $base2 ? $base1 : '.' ); + } + + return File::Spec->rel2abs( $dir ); +} + +################################# +# +# Bunzip2 code +# +################################# + +### bunzip2 wrapper... +sub _bunzip2 { + my $self = shift; + + my @methods = qw[_bunzip2_cz2 _bunzip2_bin]; + @methods = reverse @methods if $PREFER_BIN; + + for my $method (@methods) { + $self->_extractor($method) && return 1 if $self->$method(); + } + + return $self->_error(loc("Unable to bunzip2 file '%1'", $self->archive)); +} + +sub _bunzip2_bin { + my $self = shift; + + ### check for /bin/gzip -- we need it ### + return $self->_error(loc("No '%1' program found", '/bin/bunzip2')) + unless $self->bin_bunzip2; + + + my $fh = FileHandle->new('>'. $self->_gunzip_to) or + return $self->_error(loc("Could not open '%1' for writing: %2", + $self->_gunzip_to, $! )); + + my $cmd = [ $self->bin_bunzip2, '-c', $self->archive ]; + + my $buffer; + unless( scalar run( command => $cmd, + verbose => $DEBUG, + buffer => \$buffer ) + ) { + return $self->_error(loc("Unable to bunzip2 '%1': %2", + $self->archive, $buffer)); + } + + ### no buffers available? + if( !IPC::Cmd->can_capture_buffer and !$buffer ) { + $self->_error( $self->_no_buffer_content( $self->archive ) ); + } + + print $fh $buffer if defined $buffer; + + close $fh; + + ### set what files where extract, and where they went ### + $self->files( [$self->_gunzip_to] ); + $self->extract_path( File::Spec->rel2abs(cwd()) ); + + return 1; +} + +### using cz2, the compact versions... this we use mainly in archive::tar +### extractor.. +# sub _bunzip2_cz1 { +# my $self = shift; +# +# my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' }; +# unless( can_load( modules => $use_list ) ) { +# return $self->_error(loc("You do not have '%1' installed - Please " . +# "install it as soon as possible.", +# 'IO::Uncompress::Bunzip2')); +# } +# +# my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or +# return $self->_error(loc("Unable to open '%1': %2", +# $self->archive, +# $IO::Uncompress::Bunzip2::Bunzip2Error)); +# +# my $fh = FileHandle->new('>'. $self->_gunzip_to) or +# return $self->_error(loc("Could not open '%1' for writing: %2", +# $self->_gunzip_to, $! )); +# +# my $buffer; +# $fh->print($buffer) while $bz->read($buffer) > 0; +# $fh->close; +# +# ### set what files where extract, and where they went ### +# $self->files( [$self->_gunzip_to] ); +# $self->extract_path( File::Spec->rel2abs(cwd()) ); +# +# return 1; +# } + +sub _bunzip2_cz2 { + my $self = shift; + + my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' }; + unless( can_load( modules => $use_list ) ) { + return $self->_error(loc("You do not have '%1' installed - Please " . + "install it as soon as possible.", + 'IO::Uncompress::Bunzip2')); + } + + IO::Uncompress::Bunzip2::bunzip2($self->archive => $self->_gunzip_to) + or return $self->_error(loc("Unable to uncompress '%1': %2", + $self->archive, + $IO::Uncompress::Bunzip2::Bunzip2Error)); + + ### set what files where extract, and where they went ### + $self->files( [$self->_gunzip_to] ); + $self->extract_path( File::Spec->rel2abs(cwd()) ); + + return 1; +} + + +################################# +# +# Error code +# +################################# + +sub _error { + my $self = shift; + my $error = shift; + + $self->_error_msg( $error ); + $self->_error_msg_long( Carp::longmess($error) ); + + ### set $Archive::Extract::WARN to 0 to disable printing + ### of errors + if( $WARN ) { + carp $DEBUG ? $self->_error_msg_long : $self->_error_msg; + } + + return; +} + +sub error { + my $self = shift; + return shift() ? $self->_error_msg_long : $self->_error_msg; +} + +sub _no_buffer_files { + my $self = shift; + my $file = shift or return; + return loc("No buffer captured, unable to tell ". + "extracted files or extraction dir for '%1'", $file); +} + +sub _no_buffer_content { + my $self = shift; + my $file = shift or return; + return loc("No buffer captured, unable to get content for '%1'", $file); +} +1; + +=pod + +=head1 HOW IT WORKS + +C tries first to determine what type of archive you +are passing it, by inspecting its suffix. It does not do this by using +Mime magic, or something related. See C below. + +Once it has determined the file type, it knows which extraction methods +it can use on the archive. It will try a perl solution first, then fall +back to a commandline tool if that fails. If that also fails, it will +return false, indicating it was unable to extract the archive. +See the section on C to see how to alter this order. + +=head1 CAVEATS + +=head2 File Extensions + +C trusts on the extension of the archive to determine +what type it is, and what extractor methods therefore can be used. If +your archives do not have any of the extensions as described in the +C method, you will have to specify the type explicitly, or +C will not be able to extract the archive for you. + +=head2 Bzip2 Support + +There's currently no very reliable pure perl Bzip2 implementation +available, so C can only extract C +compressed archives if you have a C program. + +=head1 GLOBAL VARIABLES + +=head2 $Archive::Extract::DEBUG + +Set this variable to C to have all calls to command line tools +be printed out, including all their output. +This also enables C errors, instead of the regular +C errors. + +Good for tracking down why things don't work with your particular +setup. + +Defaults to C. + +=head2 $Archive::Extract::WARN + +This variable controls whether errors encountered internally by +C should be C'd or not. + +Set to false to silence warnings. Inspect the output of the C +method manually to see what went wrong. + +Defaults to C. + +=head2 $Archive::Extract::PREFER_BIN + +This variables controls whether C should prefer the +use of perl modules, or commandline tools to extract archives. + +Set to C to have C prefer commandline tools. + +Defaults to C. + +=head1 TODO + +=over 4 + +=item Mime magic support + +Maybe this module should use something like C to determine +the type, rather than blindly trust the suffix. + +=head1 AUTHORS + +This module by +Jos Boumans Ekane@cpan.orgE. + +=head1 COPYRIGHT + +This module is +copyright (c) 2004-2007 Jos Boumans Ekane@cpan.orgE. +All rights reserved. + +This library is free software; +you may redistribute and/or modify it under the same +terms as Perl itself. + +=cut + +# Local variables: +# c-indentation-style: bsd +# c-basic-offset: 4 +# indent-tabs-mode: nil +# End: +# vim: expandtab shiftwidth=4: + diff --git a/lib/Archive/Extract/t/01_Archive-Extract.t b/lib/Archive/Extract/t/01_Archive-Extract.t new file mode 100644 index 0000000..2a255f5 --- /dev/null +++ b/lib/Archive/Extract/t/01_Archive-Extract.t @@ -0,0 +1,360 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir '../lib/Archive/Extract' if -d '../lib/Archive/Extract'; + unshift @INC, '../../..', '../../../..'; + } +} + +BEGIN { chdir 't' if -d 't' }; +BEGIN { mkdir 'out' unless -d 'out' }; + +use strict; +use lib qw[../lib]; + +use constant IS_WIN32 => $^O eq 'MSWin32' ? 1 : 0; +use constant IS_CYGWIN => $^O eq 'cygwin' ? 1 : 0; + +use Cwd qw[cwd]; +use Test::More qw[no_plan]; +use File::Spec; +use File::Spec::Unix; +use File::Path; +use Data::Dumper; +use File::Basename qw[basename]; +use Module::Load::Conditional qw[check_install]; + +### uninitialized value in File::Spec warnings come from A::Zip: +# t/01_Archive-Extract....ok 135/0Use of uninitialized value in concatenation (.) or string at /opt/lib/perl5/5.8.3/File/Spec/Unix.pm line 313. +# File::Spec::Unix::catpath('File::Spec','','','undef') called at /opt/lib/perl5/site_perl/5.8.3/Archive/Zip.pm line 473 +# Archive::Zip::_asLocalName('') called at /opt/lib/perl5/site_perl/5.8.3/Archive/Zip.pm line 652 +# Archive::Zip::Archive::extractMember('Archive::Zip::Archive=HASH(0x9679c8)','Archive::Zip::ZipFileMember=HASH(0x9678fc)') called at ../lib/Archive/Extract.pm line 753 +# Archive::Extract::_unzip_az('Archive::Extract=HASH(0x966eac)') called at ../lib/Archive/Extract.pm line 674 +# Archive::Extract::_unzip('Archive::Extract=HASH(0x966eac)') called at ../lib/Archive/Extract.pm line 275 +# Archive::Extract::extract('Archive::Extract=HASH(0x966eac)','to','/Users/kane/sources/p4/other/archive-extract/t/out') called at t/01_Archive-Extract.t line 180 +#BEGIN { $SIG{__WARN__} = sub { require Carp; Carp::cluck(@_) } }; + +if( IS_WIN32 or IS_CYGWIN ) { + diag( "Older versions of Archive::Zip may cause File::Spec warnings" ); + diag( "See bug #19713 in rt.cpan.org. It is safe to ignore them" ); +} + +my $Debug = $ARGV[0] ? 1 : 0; +my $Me = basename( $0 ); +my $Class = 'Archive::Extract'; +my $Self = File::Spec->rel2abs( + IS_WIN32 ? &Win32::GetShortPathName( cwd() ) : cwd() + ); +my $SrcDir = File::Spec->catdir( $Self,'src' ); +my $OutDir = File::Spec->catdir( $Self,'out' ); + +use_ok($Class); + +### set verbose if debug is on ### +### stupid stupid silly stupid warnings silly! ### +$Archive::Extract::VERBOSE = $Archive::Extract::VERBOSE = $Debug; +$Archive::Extract::WARN = $Archive::Extract::WARN = $Debug ? 1 : 0; + +my $tmpl = { + ### plain files + 'x.bz2' => { programs => [qw[bunzip2]], + modules => [qw[IO::Uncompress::Bunzip2]], + method => 'is_bz2', + outfile => 'a', + }, + 'x.tgz' => { programs => [qw[gzip tar]], + modules => [qw[Archive::Tar IO::Zlib]], + method => 'is_tgz', + outfile => 'a', + }, + 'x.tar.gz' => { programs => [qw[gzip tar]], + modules => [qw[Archive::Tar IO::Zlib]], + method => 'is_tgz', + outfile => 'a', + }, + 'x.tar' => { programs => [qw[tar]], + modules => [qw[Archive::Tar]], + method => 'is_tar', + outfile => 'a', + }, + 'x.gz' => { programs => [qw[gzip]], + modules => [qw[Compress::Zlib]], + method => 'is_gz', + outfile => 'a', + }, + 'x.zip' => { programs => [qw[unzip]], + modules => [qw[Archive::Zip]], + method => 'is_zip', + outfile => 'a', + }, + 'x.jar' => { programs => [qw[unzip]], + modules => [qw[Archive::Zip]], + method => 'is_zip', + outfile => 'a', + }, + 'x.par' => { programs => [qw[unzip]], + modules => [qw[Archive::Zip]], + method => 'is_zip', + outfile => 'a', + }, + ### with a directory + 'y.tbz' => { programs => [qw[bunzip2 tar]], + modules => [qw[Archive::Tar + IO::Uncompress::Bunzip2]], + method => 'is_tbz', + outfile => 'z', + outdir => 'y', + }, + 'y.tar.bz2' => { programs => [qw[bunzip2 tar]], + modules => [qw[Archive::Tar + IO::Uncompress::Bunzip2]], + method => 'is_tbz', + outfile => 'z', + outdir => 'y' + }, + 'y.tgz' => { programs => [qw[gzip tar]], + modules => [qw[Archive::Tar IO::Zlib]], + method => 'is_tgz', + outfile => 'z', + outdir => 'y' + }, + 'y.tar.gz' => { programs => [qw[gzip tar]], + modules => [qw[Archive::Tar IO::Zlib]], + method => 'is_tgz', + outfile => 'z', + outdir => 'y' + }, + 'y.tar' => { programs => [qw[tar]], + modules => [qw[Archive::Tar]], + method => 'is_tar', + outfile => 'z', + outdir => 'y' + }, + 'y.zip' => { programs => [qw[unzip]], + modules => [qw[Archive::Zip]], + method => 'is_zip', + outfile => 'z', + outdir => 'y' + }, + 'y.par' => { programs => [qw[unzip]], + modules => [qw[Archive::Zip]], + method => 'is_zip', + outfile => 'z', + outdir => 'y' + }, + 'y.jar' => { programs => [qw[unzip]], + modules => [qw[Archive::Zip]], + method => 'is_zip', + outfile => 'z', + outdir => 'y' + }, + ### with non-same top dir + 'double_dir.zip' => { + programs => [qw[unzip]], + modules => [qw[Archive::Zip]], + method => 'is_zip', + outfile => 'w', + outdir => 'x' + }, +}; + +### show us the tools IPC::Cmd will use to run binary programs +if( $Debug ) { + diag( "IPC::Run enabled: $IPC::Cmd::USE_IPC_RUN " ); + diag( "IPC::Run available: " . IPC::Cmd->can_use_ipc_run ); + diag( "IPC::Run vesion: $IPC::Run::VERSION" ); + diag( "IPC::Open3 enabled: $IPC::Cmd::USE_IPC_OPEN3 " ); + diag( "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3 ); + diag( "IPC::Open3 vesion: $IPC::Open3::VERSION" ); +} + +### test all type specifications to new() +### this tests bug #24578: Wrong check for `type' argument +{ my $meth = 'types'; + + can_ok( $Class, $meth ); + + my @types = $Class->$meth; + ok( scalar(@types), " Got a list of types" ); + + for my $type ( @types ) { + my $obj = $Class->new( archive => $Me, type => $type ); + ok( $obj, " Object created based on '$type'" ); + ok( !$obj->error, " No error logged" ); + } +} + +### XXX whitebox test +### test __get_extract_dir +{ my $meth = '__get_extract_dir'; + + ### get the right seperator -- File::Spec does clean ups for + ### paths, so we need to join ourselves. + my $sep = [ split '', File::Spec->catfile( 'a', 'b' ) ]->[1]; + + ### bug #23999: Attempt to generate Makefile.PL gone awry + ### showed that dirs in the style of './dir/' were reported + ### to be unpacked in '.' rather than in 'dir'. here we test + ### for this. + for my $prefix ( '', '.' ) { + my $dir = basename( $SrcDir ); + + ### build a list like [dir, dir/file] and [./dir ./dir/file] + ### where the dir and file actually exist, which is important + ### for the method call + my @files = map { length $prefix + ? join $sep, $prefix, $_ + : $_ + } $dir, File::Spec->catfile( $dir, [keys %$tmpl]->[0] ); + + my $res = $Class->$meth( \@files ); + $res = &Win32::GetShortPathName( $res ) if IS_WIN32; + + ok( $res, "Found extraction dir '$res'" ); + is( $res, $SrcDir, " Is expected dir '$SrcDir'" ); + } +} + +for my $switch (0,1) { + + local $Archive::Extract::PREFER_BIN = $switch; + diag("Running extract with PREFER_BIN = $Archive::Extract::PREFER_BIN") + if $Debug; + + for my $archive (keys %$tmpl) { + + diag("Extracting $archive") if $Debug; + + ### check first if we can do the proper + + my $ae = Archive::Extract->new( + archive => File::Spec->catfile($SrcDir,$archive) ); + + isa_ok( $ae, $Class ); + + my $method = $tmpl->{$archive}->{method}; + ok( $ae->$method(), "Archive type recognized properly" ); + + ### 10 tests from here on down ### + SKIP: { + my $file = $tmpl->{$archive}->{outfile}; + my $dir = $tmpl->{$archive}->{outdir}; # can be undef + my $rel_path = File::Spec->catfile( grep { defined } $dir, $file ); + my $abs_path = File::Spec->catfile( $OutDir, $rel_path ); + my $abs_dir = File::Spec->catdir( + grep { defined } $OutDir, $dir ); + my $nix_path = File::Spec::Unix->catfile( + grep { defined } $dir, $file ); + + ### check if we can run this test ### + my $pgm_fail; my $mod_fail; + for my $pgm ( @{$tmpl->{$archive}->{programs}} ) { + ### no binary extract method + $pgm_fail++, next unless $pgm; + + ### we dont have the program + $pgm_fail++ unless $Archive::Extract::PROGRAMS->{$pgm} && + $Archive::Extract::PROGRAMS->{$pgm}; + + } + + for my $mod ( @{$tmpl->{$archive}->{modules}} ) { + ### no module extract method + $mod_fail++, next unless $mod; + + ### we dont have the module + $mod_fail++ unless check_install( module => $mod ); + } + + ### where to extract to -- try both dir and file for gz files + ### XXX test me! + #my @outs = $ae->is_gz ? ($abs_path, $OutDir) : ($OutDir); + my @outs = $ae->is_gz || $ae->is_bz2 ? ($abs_path) : ($OutDir); + + skip "No binaries or modules to extract ".$archive, + (10 * scalar @outs) if $mod_fail && $pgm_fail; + + + ### we dont warnings spewed about missing modules, that might + ### be a problem... + local $IPC::Cmd::WARN = 0; + local $IPC::Cmd::WARN = 0; + + for my $use_buffer ( IPC::Cmd->can_capture_buffer , 0 ) { + + ### test buffers ### + my $turn_off = !$use_buffer && !$pgm_fail && + $Archive::Extract::PREFER_BIN; + + ### whitebox test ### + ### stupid warnings ### + local $IPC::Cmd::USE_IPC_RUN = 0 if $turn_off; + local $IPC::Cmd::USE_IPC_RUN = 0 if $turn_off; + local $IPC::Cmd::USE_IPC_OPEN3 = 0 if $turn_off; + local $IPC::Cmd::USE_IPC_OPEN3 = 0 if $turn_off; + + + ### try extracting ### + for my $to ( @outs ) { + + diag("Extracting to: $to") if $Debug; + diag("Buffers enabled: ".!$turn_off) if $Debug; + + my $rv = $ae->extract( to => $to ); + + ok( $rv, "extract() for '$archive' reports success"); + + diag("Extractor was: " . $ae->_extractor) if $Debug; + + SKIP: { + my $re = qr/^No buffer captured/; + my $err = $ae->error || ''; + + ### skip buffer tests if we dont have buffers or + ### explicitly turned them off + skip "No buffers available", 7, + if ( $turn_off || !IPC::Cmd->can_capture_buffer) + && $err =~ $re; + + ### if we /should/ have buffers, there should be + ### no errors complaining we dont have them... + unlike( $err, $re, + "No errors capturing buffers" ); + + ### might be 1 or 2, depending wether we extracted + ### a dir too + my $file_cnt = grep { defined } $file, $dir; + is( scalar @{ $ae->files || []}, $file_cnt, + "Found correct number of output files" ); + is( $ae->files->[-1], $nix_path, + "Found correct output file '$nix_path'" ); + + ok( -e $abs_path, + "Output file '$abs_path' exists" ); + ok( $ae->extract_path, + "Extract dir found" ); + ok( -d $ae->extract_path, + "Extract dir exists" ); + is( $ae->extract_path, $abs_dir, + "Extract dir is expected '$abs_dir'" ); + } + + SKIP: { + skip "Unlink tests are unreliable on Win32", 3 if IS_WIN32; + + 1 while unlink $abs_path; + ok( !(-e $abs_path), "Output file successfully removed" ); + + SKIP: { + skip "No extract path captured, can't remove paths", 2 + unless $ae->extract_path; + + eval { rmtree( $ae->extract_path ) }; + ok( !$@, " rmtree gave no error" ); + ok( !(-d $ae->extract_path ), + " Extract dir succesfully removed" ); + } + } + } + } + } } +} diff --git a/lib/Archive/Extract/t/src/double_dir.zip.packed b/lib/Archive/Extract/t/src/double_dir.zip.packed new file mode 100644 index 0000000..b6a3ec3 --- /dev/null +++ b/lib/Archive/Extract/t/src/double_dir.zip.packed @@ -0,0 +1,21 @@ +######################################################################### +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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/double_dir.zip.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/double_dir.zip + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/double_dir.zip /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/double_dir.zip.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +M4$L#!`H``````&QH,S0````````````````%`!4`>"]Y+WI55`D``PR`ST,, +M@,]#57@$`/4!]0%02P,$"@``````;F@S-`````````````````,`%0!X+W=5 +M5`D``P^`ST,/@,]#57@$`/4!]0%02P$"%P,*``````!L:#,T```````````` +M````!0`-````````````I($`````>"]Y+WI55`4``PR`ST-5>```4$L!`A<# +M"@``````;F@S-`````````````````,`#0```````````*2!.````'@O=U54 +A!0`##X#/0U5X``!02P4&``````(``@!^````;@`````` diff --git a/lib/Archive/Extract/t/src/x.bz2.packed b/lib/Archive/Extract/t/src/x.bz2.packed new file mode 100644 index 0000000..391d686 --- /dev/null +++ b/lib/Archive/Extract/t/src/x.bz2.packed @@ -0,0 +1,16 @@ +######################################################################### +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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.bz2.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.bz2 + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.bz2 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.bz2.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +.0EIH.1=R13A0D``````` diff --git a/lib/Archive/Extract/t/src/x.gz.packed b/lib/Archive/Extract/t/src/x.gz.packed new file mode 100644 index 0000000..e1db8bf --- /dev/null +++ b/lib/Archive/Extract/t/src/x.gz.packed @@ -0,0 +1,16 @@ +######################################################################### +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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.gz.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.gz + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.gz /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.gz.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +6'XL(""66P4`"`V$``P`````````````` diff --git a/lib/Archive/Extract/t/src/x.jar.packed b/lib/Archive/Extract/t/src/x.jar.packed new file mode 100644 index 0000000..e034623 --- /dev/null +++ b/lib/Archive/Extract/t/src/x.jar.packed @@ -0,0 +1,18 @@ +######################################################################### +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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.jar.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.jar + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.jar /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.jar.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4! +M%`!02P$"%0,*```````+8<4P`````````````````0`,``````````!`I($` +F````8558"`!)`B%!EIO!0%!+!08``````0`!`#L````O```````` diff --git a/lib/Archive/Extract/t/src/x.par.packed b/lib/Archive/Extract/t/src/x.par.packed new file mode 100644 index 0000000..05e9a27 --- /dev/null +++ b/lib/Archive/Extract/t/src/x.par.packed @@ -0,0 +1,18 @@ +######################################################################### +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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.par.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.par + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.par /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.par.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4! +M%`!02P$"%0,*```````+8<4P`````````````````0`,``````````!`I($` +F````8558"`!)`B%!EIO!0%!+!08``````0`!`#L````O```````` diff --git a/lib/Archive/Extract/t/src/x.tar.gz.packed b/lib/Archive/Extract/t/src/x.tar.gz.packed new file mode 100644 index 0000000..8cd20e6 --- /dev/null +++ b/lib/Archive/Extract/t/src/x.tar.gz.packed @@ -0,0 +1,18 @@ +######################################################################### +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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.tar.gz.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.tar.gz + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.tar.gz /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/x.tar.gz.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@ +M]?B_K)E3:Y&;>1KWFZ?W_Q&O)(#7""1,"G?QM##!&.SDE&(]W@ +M]?B_K)E3:Y&;>1KWFZ?W_Q&O)(2]56`P`M%6W06Y4MT'U +M`10`4$L#!`H``````,NBB#$````````````````#`!``>2]Z55@,`+15MT%N +M5+=!]0$4`%!+`0(5`PH``````,NBB#$````````````````"``P````````` +M$$#M00````!Y+U58"`"T5;=!;E2W05!+`0(5`PH``````,NBB#$````````` +M```````#``P``````````$"D@3````!Y+WI56`@`M%6W06Y4MT%02P4&```` +/``(``@!Y````80`````` diff --git a/lib/Archive/Extract/t/src/y.par.packed b/lib/Archive/Extract/t/src/y.par.packed new file mode 100644 index 0000000..2f0734d --- /dev/null +++ b/lib/Archive/Extract/t/src/y.par.packed @@ -0,0 +1,21 @@ +######################################################################### +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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.par.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.par + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.par /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.par.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U +M`10`4$L#!`H``````,NBB#$````````````````#`!``>2]Z55@,`+15MT%N +M5+=!]0$4`%!+`0(5`PH``````,NBB#$````````````````"``P````````` +M$$#M00````!Y+U58"`"T5;=!;E2W05!+`0(5`PH``````,NBB#$````````` +M```````#``P``````````$"D@3````!Y+WI56`@`M%6W06Y4MT%02P4&```` +/``(``@!Y````80`````` diff --git a/lib/Archive/Extract/t/src/y.tar.bz2.packed b/lib/Archive/Extract/t/src/y.tar.bz2.packed new file mode 100644 index 0000000..d776180 --- /dev/null +++ b/lib/Archive/Extract/t/src/y.tar.bz2.packed @@ -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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.tar.bz2.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.tar.bz2 + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.tar.bz2 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.tar.bz2.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +M0EIH.3%!6293636W".T``+)[E,B``$!``/>```-B"1XP!```0``((`"2A*4] +M3U#30&@TT]30*HB,H,1D`--3Y?+C;<@FX(TTM,L$JN2Z+&24041)1Y4?5<"# +M;MBCJDU9T652V9JT8KI&Y1.6"TPL(,"BH$P]*!F,4$<<7B'88WC>S^KV +MLG$\>3\^*?WQ\```````````````#`=;T! +(N@>.G``H```` diff --git a/lib/Archive/Extract/t/src/y.tar.packed b/lib/Archive/Extract/t/src/y.tar.packed new file mode 100644 index 0000000..766aadf --- /dev/null +++ b/lib/Archive/Extract/t/src/y.tar.packed @@ -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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.tar.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.tar + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.tar /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.tar.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +M>2\````````````````````````````````````````````````````````` +M```````````````````````````````````````````````````````````` +M`````````````#`P,#`W-34`,#`P,#```-B"1XP!```0``((`"2A*4] +M3U#30&@TT]30*HB,H,1D`--3Y?+C;<@FX(TTM,L$JN2Z+&24041)1Y4?5<"# +M;MBCJDU9T652V9JT8KI&Y1.6"TPL(,"BH$P]*!F,4$<<7B'88WC>S^KV +MLG$\>3\^*?WQ\```````````````#`=;T! +(N@>.G``H```` diff --git a/lib/Archive/Extract/t/src/y.zip.packed b/lib/Archive/Extract/t/src/y.zip.packed new file mode 100644 index 0000000..4fc1477 --- /dev/null +++ b/lib/Archive/Extract/t/src/y.zip.packed @@ -0,0 +1,21 @@ +######################################################################### +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 /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.zip.packed /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.zip + +To recreate it use the following command: + + uupacktool.pl -p /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.zip /Users/kane/sources/perl-dev/perl-current-archive-extract.7657/lib/Archive/Extract/t/src/y.zip.packed + +Created at Fri Jan 26 14:27:58 2007 +######################################################################### +__UU__ +M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U +M`10`4$L#!`H``````,NBB#$````````````````#`!``>2]Z55@,`+15MT%N +M5+=!]0$4`%!+`0(5`PH``````,NBB#$````````````````"``P````````` +M$$#M00````!Y+U58"`"T5;=!;E2W05!+`0(5`PH``````,NBB#$````````` +M```````#``P``````````$"D@3````!Y+WI56`@`M%6W06Y4MT%02P4&```` +/``(``@!Y````80``````