1 ### the gnu tar specification:
2 ### http://www.gnu.org/software/tar/manual/html_mono/tar.html
4 ### and the pax format spec, which tar derives from:
5 ### http://www.opengroup.org/onlinepubs/007904975/utilities/pax.html
11 use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
12 $DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING];
20 $DO_NOT_USE_PREFIX = 0;
24 $HAS_PERLIO = $Config::Config{useperlio};
26 ### try and load IO::String anyway, so you can dynamically
27 ### switch between perlio and IO::String
32 $HAS_IO_STRING = $@ ? 0 : 1;
38 use Carp qw(carp croak);
40 use File::Spec::Unix ();
43 use Archive::Tar::File;
44 use Archive::Tar::Constant;
48 Archive::Tar - module for manipulations of tar archives
53 my $tar = Archive::Tar->new;
55 $tar->read('origin.tgz',1);
58 $tar->add_files('file/foo.pl', 'docs/README');
59 $tar->add_data('file/baz.txt', 'This is the contents now');
61 $tar->rename('oldname', 'new/file/name');
63 $tar->write('files.tar');
67 Archive::Tar provides an object oriented mechanism for handling tar
68 files. It provides class methods for quick and easy files handling
69 while also allowing for the creation of tar file objects for custom
70 manipulation. If you have the IO::Zlib module installed,
71 Archive::Tar will also support compressed or gzipped tar files.
73 An object of class Archive::Tar represents a .tar(.gz) archive full
78 =head2 Archive::Tar->new( [$file, $compressed] )
80 Returns a new Tar object. If given any arguments, C<new()> calls the
81 C<read()> method automatically, passing on the arguments provided to
84 If C<new()> is invoked with arguments and the C<read()> method fails
85 for any reason, C<new()> returns undef.
94 ### install get/set accessors for this object.
95 for my $key ( keys %$tmpl ) {
97 *{__PACKAGE__."::$key"} = sub {
99 $self->{$key} = $_[0] if @_;
100 return $self->{$key};
106 $class = ref $class if ref $class;
108 ### copying $tmpl here since a shallow copy makes it use the
109 ### same aref, causing for files to remain in memory always.
110 my $obj = bless { _data => [ ], _file => 'Unknown' }, $class;
113 unless ( $obj->read( @_ ) ) {
114 $obj->_error(qq[No data could be read from file]);
122 =head2 $tar->read ( $filename|$handle, $compressed, {opt => 'val'} )
124 Read the given tar file into memory.
125 The first argument can either be the name of a file or a reference to
126 an already open filehandle (or an IO::Zlib object if it's compressed)
127 The second argument indicates whether the file referenced by the first
128 argument is compressed.
130 The C<read> will I<replace> any previous content in C<$tar>!
132 The second argument may be considered optional if IO::Zlib is
133 installed, since it will transparently Do The Right Thing.
134 Archive::Tar will warn if you try to pass a compressed file if
135 IO::Zlib is not available and simply return.
137 The third argument can be a hash reference with options. Note that
138 all options are case-sensitive.
144 Do not read more than C<limit> files. This is useful if you have
145 very big archives, and are only interested in the first few files.
149 If set to true, immediately extract entries when reading them. This
150 gives you the same memory break as the C<extract_archive> function.
151 Note however that entries will not be read into memory, but written
156 All files are stored internally as C<Archive::Tar::File> objects.
157 Please consult the L<Archive::Tar::File> documentation for details.
159 Returns the number of files read in scalar context, and a list of
160 C<Archive::Tar::File> objects in list context.
167 my $gzip = shift || 0;
168 my $opts = shift || {};
170 unless( defined $file ) {
171 $self->_error( qq[No file to read from!] );
174 $self->_file( $file );
177 my $handle = $self->_get_handle($file, $gzip, READ_ONLY->( ZLIB ) )
180 my $data = $self->_read_tar( $handle, $opts ) or return;
182 $self->_data( $data );
184 return wantarray ? @$data : scalar @$data;
189 my $file = shift; return unless defined $file;
190 return $file if ref $file;
192 my $gzip = shift || 0;
193 my $mode = shift || READ_ONLY->( ZLIB ); # default to read only
197 ### only default to ZLIB if we're not trying to /write/ to a handle ###
198 if( ZLIB and $gzip || MODE_READ->( $mode ) ) {
200 ### IO::Zlib will Do The Right Thing, even when passed
206 $self->_error(qq[Compression not available - Install IO::Zlib!]);
215 unless( $fh->open( $file, $mode ) ) {
216 $self->_error( qq[Could not create filehandle for '$file': $!!] );
227 my $handle = shift or return;
228 my $opts = shift || {};
230 my $count = $opts->{limit} || 0;
231 my $extract = $opts->{extract} || 0;
233 ### set a cap on the amount of files to extract ###
235 $limit = 1 if $count > 0;
240 my $real_name; # to set the name of a file when
241 # we're encountering @longlink
245 while( $handle->read( $chunk, HEAD ) ) {
246 ### IO::Zlib doesn't support this yet
247 my $offset = eval { tell $handle } || 'unknown';
250 my $gzip = GZIP_MAGIC_NUM;
251 if( $chunk =~ /$gzip/ ) {
252 $self->_error( qq[Cannot read compressed format in tar-mode] );
257 ### if we can't read in all bytes... ###
258 last if length $chunk != HEAD;
260 ### Apparently this should really be two blocks of 512 zeroes,
261 ### but GNU tar sometimes gets it wrong. See comment in the
262 ### source code (tar.c) to GNU cpio.
263 next if $chunk eq TAR_END;
265 ### pass the realname, so we can set it 'proper' right away
266 ### some of the heuristics are done on the name, so important
269 { my %extra_args = ();
270 $extra_args{'name'} = $$real_name if defined $real_name;
272 unless( $entry = Archive::Tar::File->new( chunk => $chunk,
275 $self->_error( qq[Couldn't read chunk at offset $offset] );
281 ### http://www.gnu.org/manual/tar/html_node/tar_139.html
282 next if $entry->is_label;
284 if( length $entry->type and ($entry->is_file || $entry->is_longlink) ) {
286 if ( $entry->is_file && !$entry->validate ) {
287 ### sometimes the chunk is rather fux0r3d and a whole 512
288 ### bytes ends p in the ->name area.
289 ### clean it up, if need be
290 my $name = $entry->name;
291 $name = substr($name, 0, 100) if length $name > 100;
294 $self->_error( $name . qq[: checksum error] );
298 my $block = BLOCK_SIZE->( $entry->size );
300 $data = $entry->get_content_by_ref;
302 ### just read everything into memory
303 ### can't do lazy loading since IO::Zlib doesn't support 'seek'
304 ### this is because Compress::Zlib doesn't support it =/
305 ### this reads in the whole data in one read() call.
306 if( $handle->read( $$data, $block ) < $block ) {
307 $self->_error( qq[Read error on tarfile (missing data) '].
308 $entry->full_path ."' at offset $offset" );
312 ### throw away trailing garbage ###
313 substr ($$data, $entry->size) = "";
315 ### part II of the @LongLink munging -- need to do /after/
316 ### the checksum check.
317 if( $entry->is_longlink ) {
318 ### weird thing in tarfiles -- if the file is actually a
319 ### @LongLink, the data part seems to have a trailing ^@
320 ### (unprintable) char. to display, pipe output through less.
321 ### but that doesn't *always* happen.. so check if the last
322 ### character is a control character, and if so remove it
323 ### at any rate, we better remove that character here, or tests
324 ### like 'eq' and hashlook ups based on names will SO not work
325 ### remove it by calculating the proper size, and then
326 ### tossing out everything that's longer than that size.
328 ### count number of nulls
329 my $nulls = $$data =~ tr/\0/\0/;
331 ### cut data + size by that many bytes
332 $entry->size( $entry->size - $nulls );
333 substr ($$data, $entry->size) = "";
337 ### clean up of the entries.. posix tar /apparently/ has some
338 ### weird 'feature' that allows for filenames > 255 characters
339 ### they'll put a header in with as name '././@LongLink' and the
340 ### contents will be the name of the /next/ file in the archive
341 ### pretty crappy and kludgy if you ask me
343 ### set the name for the next entry if this is a @LongLink;
344 ### this is one ugly hack =/ but needed for direct extraction
345 if( $entry->is_longlink ) {
348 } elsif ( defined $real_name ) {
349 $entry->name( $$real_name );
354 $self->_extract_file( $entry ) if $extract
355 && !$entry->is_longlink
356 && !$entry->is_unknown
357 && !$entry->is_label;
359 ### Guard against tarfiles with garbage at the end
360 last LOOP if $entry->name eq '';
362 ### push only the name on the rv if we're extracting
363 ### -- for extract_archive
364 push @$tarfile, ($extract ? $entry->name : $entry);
367 $count-- unless $entry->is_longlink || $entry->is_dir;
368 last LOOP unless $count;
377 =head2 $tar->contains_file( $filename )
379 Check if the archive contains a certain file.
380 It will return true if the file is in the archive, false otherwise.
382 Note however, that this function does an exact match using C<eq>
383 on the full path. So it cannot compensate for case-insensitive file-
384 systems or compare 2 paths to see if they would point to the same
391 my $full = shift or return;
393 return 1 if $self->_find_entry($full);
397 =head2 $tar->extract( [@filenames] )
399 Write files whose names are equivalent to any of the names in
400 C<@filenames> to disk, creating subdirectories as necessary. This
401 might not work too well under VMS.
402 Under MacPerl, the file's modification time will be converted to the
403 MacOS zero of time, and appropriate conversions will be done to the
404 path. However, the length of each element of the path is not
405 inspected to see whether it's longer than MacOS currently allows (32
408 If C<extract> is called without a list of file names, the entire
409 contents of the archive are extracted.
411 Returns a list of filenames extracted.
419 ### you requested the extraction of only certian files
423 for my $entry ( @{$self->_data} ) {
424 next unless $file eq $entry->full_path;
426 ### we found the file you're looking for
432 return $self->_error( qq[Could not find '$file' in archive] );
436 ### just grab all the file items
438 @files = $self->get_files;
441 ### nothing found? that's an error
442 unless( scalar @files ) {
443 $self->_error( qq[No files found for ] . $self->_file );
448 for my $entry ( @files ) {
449 unless( $self->_extract_file( $entry ) ) {
450 $self->_error(q[Could not extract ']. $entry->full_path .q['] );
458 =head2 $tar->extract_file( $file, [$extract_path] )
460 Write an entry, whose name is equivalent to the file name provided to
461 disk. Optionally takes a second parameter, which is the full (unix)
462 path (including filename) the entry will be written to.
466 $tar->extract_file( 'name/in/archive', 'name/i/want/to/give/it' );
468 Returns true on success, false on failure.
474 my $file = shift or return;
477 my $entry = $self->_find_entry( $file )
478 or $self->_error( qq[Could not find an entry for '$file'] ), return;
480 return $self->_extract_file( $entry, $alt );
485 my $entry = shift or return;
489 ### you wanted an alternate extraction location ###
490 my $name = defined $alt ? $alt : $entry->full_path;
492 ### splitpath takes a bool at the end to indicate
493 ### that it's splitting a dir
494 my ($vol,$dirs,$file);
495 if ( defined $alt ) { # It's a local-OS path
496 ($vol,$dirs,$file) = File::Spec->splitpath( $alt,
499 ($vol,$dirs,$file) = File::Spec::Unix->splitpath( $name,
504 ### is $name an absolute path? ###
505 if( File::Spec->file_name_is_absolute( $dirs ) ) {
508 ### it's a relative path ###
510 my @dirs = File::Spec::Unix->splitdir( $dirs );
511 my @cwd = File::Spec->splitdir( $cwd );
512 $dir = File::Spec->catdir( @cwd, @dirs );
514 # catdir() returns undef if the path is longer than 255 chars on VMS
515 unless ( defined $dir ) {
516 $^W && $self->_error( qq[Could not compose a path for '$dirs'\n] );
522 if( -e $dir && !-d _ ) {
523 $^W && $self->_error( qq['$dir' exists, but it's not a directory!\n] );
528 eval { File::Path::mkpath( $dir, 0, 0777 ) };
530 $self->_error( qq[Could not create directory '$dir': $@] );
535 ### we're done if we just needed to create a dir ###
536 return 1 if $entry->is_dir;
538 my $full = File::Spec->catfile( $dir, $file );
540 if( $entry->is_unknown ) {
541 $self->_error( qq[Unknown file type for file '$full'] );
545 if( length $entry->type && $entry->is_file ) {
546 my $fh = IO::File->new;
547 $fh->open( '>' . $full ) or (
548 $self->_error( qq[Could not open file '$full': $!] ),
554 syswrite $fh, $entry->data or (
555 $self->_error( qq[Could not write data to '$full'] ),
561 $self->_error( qq[Could not close file '$full'] ),
566 $self->_make_special_file( $entry, $full ) or return;
569 utime time, $entry->mtime - TIME_OFFSET, $full or
570 $self->_error( qq[Could not update timestamp] );
572 if( $CHOWN && CAN_CHOWN ) {
573 chown $entry->uid, $entry->gid, $full or
574 $self->_error( qq[Could not set uid/gid on '$full'] );
577 ### only chmod if we're allowed to, but never chmod symlinks, since they'll
578 ### change the perms on the file they're linking too...
579 if( $CHMOD and not -l $full ) {
580 chmod $entry->mode, $full or
581 $self->_error( qq[Could not chown '$full' to ] . $entry->mode );
587 sub _make_special_file {
589 my $entry = shift or return;
590 my $file = shift; return unless defined $file;
594 if( $entry->is_symlink ) {
597 symlink( $entry->linkname, $file ) or $fail++;
600 $self->_extract_special_file_as_plain_file( $entry, $file )
604 $err = qq[Making symbolink link from '] . $entry->linkname .
605 qq[' to '$file' failed] if $fail;
607 } elsif ( $entry->is_hardlink ) {
610 link( $entry->linkname, $file ) or $fail++;
613 $self->_extract_special_file_as_plain_file( $entry, $file )
617 $err = qq[Making hard link from '] . $entry->linkname .
618 qq[' to '$file' failed] if $fail;
620 } elsif ( $entry->is_fifo ) {
621 ON_UNIX && !system('mknod', $file, 'p') or
622 $err = qq[Making fifo ']. $entry->name .qq[' failed];
624 } elsif ( $entry->is_blockdev or $entry->is_chardev ) {
625 my $mode = $entry->is_blockdev ? 'b' : 'c';
627 ON_UNIX && !system('mknod', $file, $mode,
628 $entry->devmajor, $entry->devminor) or
629 $err = qq[Making block device ']. $entry->name .qq[' (maj=] .
630 $entry->devmajor . qq[ min=] . $entry->devminor .
633 } elsif ( $entry->is_socket ) {
634 ### the original doesn't do anything special for sockets.... ###
638 return $err ? $self->_error( $err ) : 1;
641 ### don't know how to make symlinks, let's just extract the file as
643 sub _extract_special_file_as_plain_file {
645 my $entry = shift or return;
646 my $file = shift; return unless defined $file;
650 my $orig = $self->_find_entry( $entry->linkname );
653 $err = qq[Could not find file '] . $entry->linkname .
658 ### clone the entry, make it appear as a normal file ###
659 my $clone = $entry->clone;
660 $clone->_downgrade_to_plainfile;
661 $self->_extract_file( $clone, $file ) or last TRY;
666 return $self->_error($err);
669 =head2 $tar->list_files( [\@properties] )
671 Returns a list of the names of all the files in the archive.
673 If C<list_files()> is passed an array reference as its first argument
674 it returns a list of hash references containing the requested
675 properties of each file. The following list of properties is
676 supported: name, size, mtime (last modified date), mode, uid, gid,
677 linkname, uname, gname, devmajor, devminor, prefix.
679 Passing an array reference containing only one element, 'name', is
680 special cased to return a list of names rather than a list of hash
681 references, making it equivalent to calling C<list_files> without
688 my $aref = shift || [ ];
690 unless( $self->_data ) {
691 $self->read() or return;
694 if( @$aref == 0 or ( @$aref == 1 and $aref->[0] eq 'name' ) ) {
695 return map { $_->full_path } @{$self->_data};
699 #for my $obj ( @{$self->_data} ) {
700 # push @rv, { map { $_ => $obj->$_() } @$aref };
704 ### this does the same as the above.. just needs a +{ }
705 ### to make sure perl doesn't confuse it for a block
706 return map { my $o=$_;
707 +{ map { $_ => $o->$_() } @$aref }
716 unless( defined $file ) {
717 $self->_error( qq[No file specified] );
721 for my $entry ( @{$self->_data} ) {
722 my $path = $entry->full_path;
723 return $entry if $path eq $file;
726 $self->_error( qq[No such file in archive: '$file'] );
730 =head2 $tar->get_files( [@filenames] )
732 Returns the C<Archive::Tar::File> objects matching the filenames
733 provided. If no filename list was passed, all C<Archive::Tar::File>
734 objects in the current Tar object are returned.
736 Please refer to the C<Archive::Tar::File> documentation on how to
737 handle these objects.
744 return @{ $self->_data } unless @_;
747 for my $file ( @_ ) {
748 push @list, grep { defined } $self->_find_entry( $file );
754 =head2 $tar->get_content( $file )
756 Return the content of the named file.
762 my $entry = $self->_find_entry( shift ) or return;
767 =head2 $tar->replace_content( $file, $content )
769 Make the string $content be the content for the file named $file.
773 sub replace_content {
775 my $entry = $self->_find_entry( shift ) or return;
777 return $entry->replace_content( shift );
780 =head2 $tar->rename( $file, $new_name )
782 Rename the file of the in-memory archive to $new_name.
784 Note that you must specify a Unix path for $new_name, since per tar
785 standard, all files in the archive must be Unix paths.
787 Returns true on success and false on failure.
793 my $file = shift; return unless defined $file;
794 my $new = shift; return unless defined $new;
796 my $entry = $self->_find_entry( $file ) or return;
798 return $entry->rename( $new );
801 =head2 $tar->remove (@filenamelist)
803 Removes any entries with names matching any of the given filenames
804 from the in-memory archive. Returns a list of C<Archive::Tar::File>
813 my %seen = map { $_->full_path => $_ } @{$self->_data};
814 delete $seen{ $_ } for @list;
816 $self->_data( [values %seen] );
823 C<clear> clears the current in-memory archive. This effectively gives
824 you a 'blank' object, ready to be filled again. Note that C<clear>
825 only has effect on the object, not the underlying tarfile.
830 my $self = shift or return;
839 =head2 $tar->write ( [$file, $compressed, $prefix] )
841 Write the in-memory archive to disk. The first argument can either
842 be the name of a file or a reference to an already open filehandle (a
843 GLOB reference). If the second argument is true, the module will use
844 IO::Zlib to write the file in a compressed format. If IO::Zlib is
845 not available, the C<write> method will fail and return.
847 Note that when you pass in a filehandle, the compression argument
848 is ignored, as all files are printed verbatim to your filehandle.
849 If you wish to enable compression with filehandles, use an
850 C<IO::Zlib> filehandle instead.
852 Specific levels of compression can be chosen by passing the values 2
853 through 9 as the second parameter.
855 The third argument is an optional prefix. All files will be tucked
856 away in the directory you specify as prefix. So if you have files
857 'a' and 'b' in your archive, and you specify 'foo' as prefix, they
858 will be written to the archive as 'foo/a' and 'foo/b'.
860 If no arguments are given, C<write> returns the entire formatted
861 archive as a string, which could be useful if you'd like to stuff the
862 archive into a socket or a pipe to gzip or something.
868 my $file = shift; $file = '' unless defined $file;
869 my $gzip = shift || 0;
870 my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix;
873 ### only need a handle if we have a file to print to ###
874 my $handle = length($file)
875 ? ( $self->_get_handle($file, $gzip, WRITE_ONLY->($gzip) )
877 : $HAS_PERLIO ? do { open my $h, '>', \$dummy; $h }
878 : $HAS_IO_STRING ? IO::String->new
879 : __PACKAGE__->no_string_support();
883 for my $entry ( @{$self->_data} ) {
884 ### entries to be written to the tarfile ###
887 ### only now will we change the object to reflect the current state
888 ### of the name and prefix fields -- this needs to be limited to
890 my $clone = $entry->clone;
893 ### so, if you don't want use to use the prefix, we'll stuff
894 ### everything in the name field instead
895 if( $DO_NOT_USE_PREFIX ) {
897 ### you might have an extended prefix, if so, set it in the clone
898 ### XXX is ::Unix right?
899 $clone->name( length $ext_prefix
900 ? File::Spec::Unix->catdir( $ext_prefix,
902 : $clone->full_path );
903 $clone->prefix( '' );
905 ### otherwise, we'll have to set it properly -- prefix part in the
906 ### prefix and name part in the name field.
909 ### split them here, not before!
910 my ($prefix,$name) = $clone->_prefix_and_file( $clone->full_path );
912 ### you might have an extended prefix, if so, set it in the clone
913 ### XXX is ::Unix right?
914 $prefix = File::Spec::Unix->catdir( $ext_prefix, $prefix )
915 if length $ext_prefix;
917 $clone->prefix( $prefix );
918 $clone->name( $name );
921 ### names are too long, and will get truncated if we don't add a
922 ### '@LongLink' file...
923 my $make_longlink = ( length($clone->name) > NAME_LENGTH or
924 length($clone->prefix) > PREFIX_LENGTH
927 ### perhaps we need to make a longlink file?
928 if( $make_longlink ) {
929 my $longlink = Archive::Tar::File->new(
930 data => LONGLINK_NAME,
935 unless( $longlink ) {
936 $self->_error( qq[Could not create 'LongLink' entry for ] .
937 qq[oversize file '] . $clone->full_path ."'" );
941 push @write_me, $longlink;
944 push @write_me, $clone;
946 ### write the one, optionally 2 a::t::file objects to the handle
947 for my $clone (@write_me) {
949 ### if the file is a symlink, there are 2 options:
950 ### either we leave the symlink intact, but then we don't write any
951 ### data OR we follow the symlink, which means we actually make a
952 ### copy. if we do the latter, we have to change the TYPE of the
954 my $link_ok = $clone->is_symlink && $Archive::Tar::FOLLOW_SYMLINK;
955 my $data_ok = !$clone->is_symlink && $clone->has_content;
957 ### downgrade to a 'normal' file if it's a symlink we're going to
958 ### treat as a regular file
959 $clone->_downgrade_to_plainfile if $link_ok;
961 ### get the header for this block
962 my $header = $self->_format_tar_entry( $clone );
964 $self->_error(q[Could not format header for: ] .
969 unless( print $handle $header ) {
970 $self->_error(q[Could not write header for: ] .
975 if( $link_ok or $data_ok ) {
976 unless( print $handle $clone->data ) {
977 $self->_error(q[Could not write data for: ] .
982 ### pad the end of the clone if required ###
983 print $handle TAR_PAD->( $clone->size ) if $clone->size % BLOCK
986 } ### done writing these entries
989 ### write the end markers ###
990 print $handle TAR_END x 2 or
991 return $self->_error( qq[Could not write tar end markers] );
992 ### did you want it written to a file, or returned as a string? ###
993 return length($file) ? 1
994 : $HAS_PERLIO ? $dummy
995 : do { seek $handle, 0, 0; local $/; <$handle> }
998 sub _format_tar_entry {
1000 my $entry = shift or return;
1001 my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix;
1002 my $no_prefix = shift || 0;
1004 my $file = $entry->name;
1005 my $prefix = $entry->prefix; $prefix = '' unless defined $prefix;
1007 ### remove the prefix from the file name
1008 ### not sure if this is still neeeded --kane
1009 ### no it's not -- Archive::Tar::File->_new_from_file will take care of
1010 ### this for us. Even worse, this would break if we tried to add a file
1012 #if( length $prefix ) {
1013 # $file =~ s/^$match//;
1016 $prefix = File::Spec::Unix->catdir($ext_prefix, $prefix)
1017 if length $ext_prefix;
1019 ### not sure why this is... ###
1020 my $l = PREFIX_LENGTH; # is ambiguous otherwise...
1021 substr ($prefix, 0, -$l) = "" if length $prefix >= PREFIX_LENGTH;
1023 my $f1 = "%06o"; my $f2 = "%11o";
1025 ### this might be optimizable with a 'changed' flag in the file objects ###
1030 (map { sprintf( $f1, $entry->$_() ) } qw[mode uid gid]),
1031 (map { sprintf( $f2, $entry->$_() ) } qw[size mtime]),
1033 "", # checksum field - space padded a bit down
1035 (map { $entry->$_() } qw[type linkname magic]),
1037 $entry->version || TAR_VERSION,
1039 (map { $entry->$_() } qw[uname gname]),
1040 (map { sprintf( $f1, $entry->$_() ) } qw[devmajor devminor]),
1042 ($no_prefix ? '' : $prefix)
1045 ### add the checksum ###
1046 substr($tar,148,7) = sprintf("%6o\0", unpack("%16C*",$tar));
1051 =head2 $tar->add_files( @filenamelist )
1053 Takes a list of filenames and adds them to the in-memory archive.
1055 The path to the file is automatically converted to a Unix like
1056 equivalent for use in the archive, and, if on MacOS, the file's
1057 modification time is converted from the MacOS epoch to the Unix epoch.
1058 So tar archives created on MacOS with B<Archive::Tar> can be read
1059 both with I<tar> on Unix and applications like I<suntar> or
1060 I<Stuffit Expander> on MacOS.
1062 Be aware that the file's type/creator and resource fork will be lost,
1063 which is usually what you want in cross-platform archives.
1065 Returns a list of C<Archive::Tar::File> objects that were just added.
1071 my @files = @_ or return;
1074 for my $file ( @files ) {
1075 unless( -e $file ) {
1076 $self->_error( qq[No such file: '$file'] );
1080 my $obj = Archive::Tar::File->new( file => $file );
1082 $self->_error( qq[Unable to add file: '$file'] );
1089 push @{$self->{_data}}, @rv;
1094 =head2 $tar->add_data ( $filename, $data, [$opthashref] )
1096 Takes a filename, a scalar full of data and optionally a reference to
1097 a hash with specific options.
1099 Will add a file to the in-memory archive, with name C<$filename> and
1100 content C<$data>. Specific properties can be set using C<$opthashref>.
1101 The following list of properties is supported: name, size, mtime
1102 (last modified date), mode, uid, gid, linkname, uname, gname,
1103 devmajor, devminor, prefix. (On MacOS, the file's path and
1104 modification times are converted to Unix equivalents.)
1106 Returns the C<Archive::Tar::File> object that was just added, or
1107 C<undef> on failure.
1113 my ($file, $data, $opt) = @_;
1115 my $obj = Archive::Tar::File->new( data => $file, $data, $opt );
1117 $self->_error( qq[Unable to add file: '$file'] );
1121 push @{$self->{_data}}, $obj;
1126 =head2 $tar->error( [$BOOL] )
1128 Returns the current errorstring (usually, the last error reported).
1129 If a true value was specified, it will give the C<Carp::longmess>
1130 equivalent of the error, in effect giving you a stacktrace.
1132 For backwards compatibility, this error is also available as
1133 C<$Archive::Tar::error> although it is much recommended you use the
1134 method call instead.
1144 my $msg = $error = shift;
1145 $longmess = Carp::longmess($error);
1147 ### set Archive::Tar::WARN to 0 to disable printing
1150 carp $DEBUG ? $longmess : $msg;
1158 return shift() ? $longmess : $error;
1163 =head2 $bool = $tar->has_io_string
1165 Returns true if we currently have C<IO::String> support loaded.
1167 Either C<IO::String> or C<perlio> support is needed to support writing
1168 stringified archives. Currently, C<perlio> is the preferred method, if
1171 See the C<GLOBAL VARIABLES> section to see how to change this preference.
1175 sub has_io_string { return $HAS_IO_STRING; }
1177 =head2 $bool = $tar->has_perlio
1179 Returns true if we currently have C<perlio> support loaded.
1181 This requires C<perl-5.8> or higher, compiled with C<perlio>
1183 Either C<IO::String> or C<perlio> support is needed to support writing
1184 stringified archives. Currently, C<perlio> is the preferred method, if
1187 See the C<GLOBAL VARIABLES> section to see how to change this preference.
1191 sub has_perlio { return $HAS_PERLIO; }
1194 =head1 Class Methods
1196 =head2 Archive::Tar->create_archive($file, $compression, @filelist)
1198 Creates a tar file from the list of files provided. The first
1199 argument can either be the name of the tar file to create or a
1200 reference to an open file handle (e.g. a GLOB reference).
1202 The second argument specifies the level of compression to be used, if
1203 any. Compression of tar files requires the installation of the
1204 IO::Zlib module. Specific levels of compression may be
1205 requested by passing a value between 2 and 9 as the second argument.
1206 Any other value evaluating as true will result in the default
1207 compression level being used.
1209 Note that when you pass in a filehandle, the compression argument
1210 is ignored, as all files are printed verbatim to your filehandle.
1211 If you wish to enable compression with filehandles, use an
1212 C<IO::Zlib> filehandle instead.
1214 The remaining arguments list the files to be included in the tar file.
1215 These files must all exist. Any files which don't exist or can't be
1216 read are silently ignored.
1218 If the archive creation fails for any reason, C<create_archive> will
1219 return false. Please use the C<error> method to find the cause of the
1222 Note that this method does not write C<on the fly> as it were; it
1223 still reads all the files into memory before writing out the archive.
1224 Consult the FAQ below if this is a problem.
1228 sub create_archive {
1231 my $file = shift; return unless defined $file;
1232 my $gzip = shift || 0;
1236 return $class->_error( qq[Cowardly refusing to create empty archive!] );
1239 my $tar = $class->new;
1240 $tar->add_files( @files );
1241 return $tar->write( $file, $gzip );
1244 =head2 Archive::Tar->list_archive ($file, $compressed, [\@properties])
1246 Returns a list of the names of all the files in the archive. The
1247 first argument can either be the name of the tar file to list or a
1248 reference to an open file handle (e.g. a GLOB reference).
1250 If C<list_archive()> is passed an array reference as its third
1251 argument it returns a list of hash references containing the requested
1252 properties of each file. The following list of properties is
1253 supported: name, size, mtime (last modified date), mode, uid, gid,
1254 linkname, uname, gname, devmajor, devminor, prefix.
1256 Passing an array reference containing only one element, 'name', is
1257 special cased to return a list of names rather than a list of hash
1264 my $file = shift; return unless defined $file;
1265 my $gzip = shift || 0;
1267 my $tar = $class->new($file, $gzip);
1270 return $tar->list_files( @_ );
1273 =head2 Archive::Tar->extract_archive ($file, $gzip)
1275 Extracts the contents of the tar file. The first argument can either
1276 be the name of the tar file to create or a reference to an open file
1277 handle (e.g. a GLOB reference). All relative paths in the tar file will
1278 be created underneath the current working directory.
1280 C<extract_archive> will return a list of files it extracted.
1281 If the archive extraction fails for any reason, C<extract_archive>
1282 will return false. Please use the C<error> method to find the cause
1287 sub extract_archive {
1289 my $file = shift; return unless defined $file;
1290 my $gzip = shift || 0;
1292 my $tar = $class->new( ) or return;
1294 return $tar->read( $file, $gzip, { extract => 1 } );
1297 =head2 Archive::Tar->can_handle_compressed_files
1299 A simple checking routine, which will return true if C<Archive::Tar>
1300 is able to uncompress compressed archives on the fly with C<IO::Zlib>,
1301 or false if C<IO::Zlib> is not installed.
1303 You can use this as a shortcut to determine whether C<Archive::Tar>
1304 will do what you think before passing compressed archives to its
1309 sub can_handle_compressed_files { return ZLIB ? 1 : 0 }
1311 sub no_string_support {
1312 croak("You have to install IO::String to support writing archives to strings");
1319 =head1 GLOBAL VARIABLES
1321 =head2 $Archive::Tar::FOLLOW_SYMLINK
1323 Set this variable to C<1> to make C<Archive::Tar> effectively make a
1324 copy of the file when extracting. Default is C<0>, which
1325 means the symlink stays intact. Of course, you will have to pack the
1326 file linked to as well.
1328 This option is checked when you write out the tarfile using C<write>
1329 or C<create_archive>.
1331 This works just like C</bin/tar>'s C<-h> option.
1333 =head2 $Archive::Tar::CHOWN
1335 By default, C<Archive::Tar> will try to C<chown> your files if it is
1336 able to. In some cases, this may not be desired. In that case, set
1337 this variable to C<0> to disable C<chown>-ing, even if it were
1340 The default is C<1>.
1342 =head2 $Archive::Tar::CHMOD
1344 By default, C<Archive::Tar> will try to C<chmod> your files to
1345 whatever mode was specified for the particular file in the archive.
1346 In some cases, this may not be desired. In that case, set this
1347 variable to C<0> to disable C<chmod>-ing.
1349 The default is C<1>.
1351 =head2 $Archive::Tar::DO_NOT_USE_PREFIX
1353 By default, C<Archive::Tar> will try to put paths that are over
1354 100 characters in the C<prefix> field of your tar header. However,
1355 some older tar programs do not implement this spec. To retain
1356 compatibility with these older versions, you can set the
1357 C<$DO_NOT_USE_PREFIX> variable to a true value, and C<Archive::Tar>
1358 will use an alternate way of dealing with paths over 100 characters
1359 by using the C<GNU Extended Header> feature.
1361 The default is C<0>.
1363 =head2 $Archive::Tar::DEBUG
1365 Set this variable to C<1> to always get the C<Carp::longmess> output
1366 of the warnings, instead of the regular C<carp>. This is the same
1367 message you would get by doing:
1373 =head2 $Archive::Tar::WARN
1375 Set this variable to C<0> if you do not want any warnings printed.
1376 Personally I recommend against doing this, but people asked for the
1377 option. Also, be advised that this is of course not threadsafe.
1381 =head2 $Archive::Tar::error
1383 Holds the last reported error. Kept for historical reasons, but its
1384 use is very much discouraged. Use the C<error()> method instead:
1386 warn $tar->error unless $tar->extract;
1388 =head2 $Archive::Tar::HAS_PERLIO
1390 This variable holds a boolean indicating if we currently have
1391 C<perlio> support loaded. This will be enabled for any perl
1392 greater than C<5.8> compiled with C<perlio>.
1394 If you feel strongly about disabling it, set this variable to
1395 C<false>. Note that you will then need C<IO::String> installed
1396 to support writing stringified archives.
1398 Don't change this variable unless you B<really> know what you're
1401 =head2 $Archive::Tar::HAS_IO_STRING
1403 This variable holds a boolean indicating if we currently have
1404 C<IO::String> support loaded. This will be enabled for any perl
1405 that has a loadable C<IO::String> module.
1407 If you feel strongly about disabling it, set this variable to
1408 C<false>. Note that you will then need C<perlio> support from
1409 your perl to be able to write stringified archives.
1411 Don't change this variable unless you B<really> know what you're
1418 =item What's the minimum perl version required to run Archive::Tar?
1420 You will need perl version 5.005_03 or newer.
1422 =item Isn't Archive::Tar slow?
1424 Yes it is. It's pure perl, so it's a lot slower then your C</bin/tar>
1425 However, it's very portable. If speed is an issue, consider using
1426 C</bin/tar> instead.
1428 =item Isn't Archive::Tar heavier on memory than /bin/tar?
1430 Yes it is, see previous answer. Since C<Compress::Zlib> and therefore
1431 C<IO::Zlib> doesn't support C<seek> on their filehandles, there is little
1432 choice but to read the archive into memory.
1433 This is ok if you want to do in-memory manipulation of the archive.
1434 If you just want to extract, use the C<extract_archive> class method
1435 instead. It will optimize and write to disk immediately.
1437 =item Can't you lazy-load data instead?
1439 No, not easily. See previous question.
1441 =item How much memory will an X kb tar file need?
1443 Probably more than X kb, since it will all be read into memory. If
1444 this is a problem, and you don't need to do in memory manipulation
1445 of the archive, consider using C</bin/tar> instead.
1447 =item What do you do with unsupported filetypes in an archive?
1449 C<Unix> has a few filetypes that aren't supported on other platforms,
1450 like C<Win32>. If we encounter a C<hardlink> or C<symlink> we'll just
1451 try to make a copy of the original file, rather than throwing an error.
1453 This does require you to read the entire archive in to memory first,
1454 since otherwise we wouldn't know what data to fill the copy with.
1455 (This means that you cannot use the class methods on archives that
1456 have incompatible filetypes and still expect things to work).
1458 For other filetypes, like C<chardevs> and C<blockdevs> we'll warn that
1459 the extraction of this particular item didn't work.
1461 =item How do I access .tar.Z files?
1463 The C<Archive::Tar> module can optionally use C<Compress::Zlib> (via
1464 the C<IO::Zlib> module) to access tar files that have been compressed
1465 with C<gzip>. Unfortunately tar files compressed with the Unix C<compress>
1466 utility cannot be read by C<Compress::Zlib> and so cannot be directly
1467 accesses by C<Archive::Tar>.
1469 If the C<uncompress> or C<gunzip> programs are available, you can use
1470 one of these workarounds to read C<.tar.Z> files from C<Archive::Tar>
1472 Firstly with C<uncompress>
1476 open F, "uncompress -c $filename |";
1477 my $tar = Archive::Tar->new(*F);
1480 and this with C<gunzip>
1484 open F, "gunzip -c $filename |";
1485 my $tar = Archive::Tar->new(*F);
1488 Similarly, if the C<compress> program is available, you can use this to
1489 write a C<.tar.Z> file
1494 my $fh = new IO::File "| compress -c >$filename";
1495 my $tar = Archive::Tar->new();
1507 =item Check if passed in handles are open for read/write
1509 Currently I don't know of any portable pure perl way to do this.
1510 Suggestions welcome.
1517 Jos Boumans E<lt>kane@cpan.orgE<gt>.
1519 =head1 ACKNOWLEDGEMENTS
1521 Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney and
1522 especially Andrew Savige for their help and suggestions.
1527 copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
1528 All rights reserved.
1530 This library is free software;
1531 you may redistribute and/or modify it under the same
1532 terms as Perl itself.