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 return unless $obj->read( @_ );
119 =head2 $tar->read ( $filename|$handle, $compressed, {opt => 'val'} )
121 Read the given tar file into memory.
122 The first argument can either be the name of a file or a reference to
123 an already open filehandle (or an IO::Zlib object if it's compressed)
124 The second argument indicates whether the file referenced by the first
125 argument is compressed.
127 The C<read> will I<replace> any previous content in C<$tar>!
129 The second argument may be considered optional if IO::Zlib is
130 installed, since it will transparently Do The Right Thing.
131 Archive::Tar will warn if you try to pass a compressed file if
132 IO::Zlib is not available and simply return.
134 The third argument can be a hash reference with options. Note that
135 all options are case-sensitive.
141 Do not read more than C<limit> files. This is useful if you have
142 very big archives, and are only interested in the first few files.
146 If set to true, immediately extract entries when reading them. This
147 gives you the same memory break as the C<extract_archive> function.
148 Note however that entries will not be read into memory, but written
153 All files are stored internally as C<Archive::Tar::File> objects.
154 Please consult the L<Archive::Tar::File> documentation for details.
156 Returns the number of files read in scalar context, and a list of
157 C<Archive::Tar::File> objects in list context.
164 my $gzip = shift || 0;
165 my $opts = shift || {};
167 unless( defined $file ) {
168 $self->_error( qq[No file to read from!] );
171 $self->_file( $file );
174 my $handle = $self->_get_handle($file, $gzip, READ_ONLY->( ZLIB ) )
177 my $data = $self->_read_tar( $handle, $opts ) or return;
179 $self->_data( $data );
181 return wantarray ? @$data : scalar @$data;
186 my $file = shift; return unless defined $file;
187 return $file if ref $file;
189 my $gzip = shift || 0;
190 my $mode = shift || READ_ONLY->( ZLIB ); # default to read only
194 ### only default to ZLIB if we're not trying to /write/ to a handle ###
195 if( ZLIB and $gzip || MODE_READ->( $mode ) ) {
197 ### IO::Zlib will Do The Right Thing, even when passed
203 $self->_error(qq[Compression not available - Install IO::Zlib!]);
212 unless( $fh->open( $file, $mode ) ) {
213 $self->_error( qq[Could not create filehandle for '$file': $!!] );
224 my $handle = shift or return;
225 my $opts = shift || {};
227 my $count = $opts->{limit} || 0;
228 my $extract = $opts->{extract} || 0;
230 ### set a cap on the amount of files to extract ###
232 $limit = 1 if $count > 0;
237 my $real_name; # to set the name of a file when
238 # we're encountering @longlink
242 while( $handle->read( $chunk, HEAD ) ) {
243 ### IO::Zlib doesn't support this yet
244 my $offset = eval { tell $handle } || 'unknown';
247 my $gzip = GZIP_MAGIC_NUM;
248 if( $chunk =~ /$gzip/ ) {
249 $self->_error( qq[Cannot read compressed format in tar-mode] );
254 ### if we can't read in all bytes... ###
255 last if length $chunk != HEAD;
257 ### Apparently this should really be two blocks of 512 zeroes,
258 ### but GNU tar sometimes gets it wrong. See comment in the
259 ### source code (tar.c) to GNU cpio.
260 next if $chunk eq TAR_END;
263 unless( $entry = Archive::Tar::File->new( chunk => $chunk ) ) {
264 $self->_error( qq[Couldn't read chunk at offset $offset] );
269 ### http://www.gnu.org/manual/tar/html_node/tar_139.html
270 next if $entry->is_label;
272 if( length $entry->type and ($entry->is_file || $entry->is_longlink) ) {
274 if ( $entry->is_file && !$entry->validate ) {
275 ### sometimes the chunk is rather fux0r3d and a whole 512
276 ### bytes ends p in the ->name area.
277 ### clean it up, if need be
278 my $name = $entry->name;
279 $name = substr($name, 0, 100) if length $name > 100;
282 $self->_error( $name . qq[: checksum error] );
286 my $block = BLOCK_SIZE->( $entry->size );
288 $data = $entry->get_content_by_ref;
290 ### just read everything into memory
291 ### can't do lazy loading since IO::Zlib doesn't support 'seek'
292 ### this is because Compress::Zlib doesn't support it =/
293 ### this reads in the whole data in one read() call.
294 if( $handle->read( $$data, $block ) < $block ) {
295 $self->_error( qq[Read error on tarfile (missing data) '].
296 $entry->full_path ."' at offset $offset" );
300 ### throw away trailing garbage ###
301 substr ($$data, $entry->size) = "";
303 ### part II of the @LongLink munging -- need to do /after/
304 ### the checksum check.
305 if( $entry->is_longlink ) {
306 ### weird thing in tarfiles -- if the file is actually a
307 ### @LongLink, the data part seems to have a trailing ^@
308 ### (unprintable) char. to display, pipe output through less.
309 ### but that doesn't *always* happen.. so check if the last
310 ### character is a control character, and if so remove it
311 ### at any rate, we better remove that character here, or tests
312 ### like 'eq' and hashlook ups based on names will SO not work
313 ### remove it by calculating the proper size, and then
314 ### tossing out everything that's longer than that size.
316 ### count number of nulls
317 my $nulls = $$data =~ tr/\0/\0/;
319 ### cut data + size by that many bytes
320 $entry->size( $entry->size - $nulls );
321 substr ($$data, $entry->size) = "";
325 ### clean up of the entries.. posix tar /apparently/ has some
326 ### weird 'feature' that allows for filenames > 255 characters
327 ### they'll put a header in with as name '././@LongLink' and the
328 ### contents will be the name of the /next/ file in the archive
329 ### pretty crappy and kludgy if you ask me
331 ### set the name for the next entry if this is a @LongLink;
332 ### this is one ugly hack =/ but needed for direct extraction
333 if( $entry->is_longlink ) {
336 } elsif ( defined $real_name ) {
337 $entry->name( $$real_name );
342 $self->_extract_file( $entry ) if $extract
343 && !$entry->is_longlink
344 && !$entry->is_unknown
345 && !$entry->is_label;
347 ### Guard against tarfiles with garbage at the end
348 last LOOP if $entry->name eq '';
350 ### push only the name on the rv if we're extracting
351 ### -- for extract_archive
352 push @$tarfile, ($extract ? $entry->name : $entry);
355 $count-- unless $entry->is_longlink || $entry->is_dir;
356 last LOOP unless $count;
365 =head2 $tar->contains_file( $filename )
367 Check if the archive contains a certain file.
368 It will return true if the file is in the archive, false otherwise.
370 Note however, that this function does an exact match using C<eq>
371 on the full path. So it cannot compensate for case-insensitive file-
372 systems or compare 2 paths to see if they would point to the same
379 my $full = shift or return;
381 return 1 if $self->_find_entry($full);
385 =head2 $tar->extract( [@filenames] )
387 Write files whose names are equivalent to any of the names in
388 C<@filenames> to disk, creating subdirectories as necessary. This
389 might not work too well under VMS.
390 Under MacPerl, the file's modification time will be converted to the
391 MacOS zero of time, and appropriate conversions will be done to the
392 path. However, the length of each element of the path is not
393 inspected to see whether it's longer than MacOS currently allows (32
396 If C<extract> is called without a list of file names, the entire
397 contents of the archive are extracted.
399 Returns a list of filenames extracted.
407 ### you requested the extraction of only certian files
411 for my $entry ( @{$self->_data} ) {
412 next unless $file eq $entry->full_path;
414 ### we found the file you're looking for
420 return $self->_error( qq[Could not find '$file' in archive] );
424 ### just grab all the file items
426 @files = $self->get_files;
429 ### nothing found? that's an error
430 unless( scalar @files ) {
431 $self->_error( qq[No files found for ] . $self->_file );
436 for my $entry ( @files ) {
437 unless( $self->_extract_file( $entry ) ) {
438 $self->_error(q[Could not extract ']. $entry->full_path .q['] );
446 =head2 $tar->extract_file( $file, [$extract_path] )
448 Write an entry, whose name is equivalent to the file name provided to
449 disk. Optionally takes a second parameter, which is the full (unix)
450 path (including filename) the entry will be written to.
454 $tar->extract_file( 'name/in/archive', 'name/i/want/to/give/it' );
456 Returns true on success, false on failure.
462 my $file = shift or return;
465 my $entry = $self->_find_entry( $file )
466 or $self->_error( qq[Could not find an entry for '$file'] ), return;
468 return $self->_extract_file( $entry, $alt );
473 my $entry = shift or return;
477 ### you wanted an alternate extraction location ###
478 my $name = defined $alt ? $alt : $entry->full_path;
480 ### splitpath takes a bool at the end to indicate
481 ### that it's splitting a dir
482 my ($vol,$dirs,$file);
483 if ( defined $alt ) { # It's a local-OS path
484 ($vol,$dirs,$file) = File::Spec->splitpath( $alt,
487 ($vol,$dirs,$file) = File::Spec::Unix->splitpath( $name,
492 ### is $name an absolute path? ###
493 if( File::Spec->file_name_is_absolute( $dirs ) ) {
496 ### it's a relative path ###
498 my @dirs = File::Spec::Unix->splitdir( $dirs );
499 my @cwd = File::Spec->splitdir( $cwd );
500 $dir = File::Spec->catdir(@cwd, @dirs);
503 if( -e $dir && !-d _ ) {
504 $^W && $self->_error( qq['$dir' exists, but it's not a directory!\n] );
509 eval { File::Path::mkpath( $dir, 0, 0777 ) };
511 $self->_error( qq[Could not create directory '$dir': $@] );
516 ### we're done if we just needed to create a dir ###
517 return 1 if $entry->is_dir;
519 my $full = File::Spec->catfile( $dir, $file );
521 if( $entry->is_unknown ) {
522 $self->_error( qq[Unknown file type for file '$full'] );
526 if( length $entry->type && $entry->is_file ) {
527 my $fh = IO::File->new;
528 $fh->open( '>' . $full ) or (
529 $self->_error( qq[Could not open file '$full': $!] ),
535 syswrite $fh, $entry->data or (
536 $self->_error( qq[Could not write data to '$full'] ),
542 $self->_error( qq[Could not close file '$full'] ),
547 $self->_make_special_file( $entry, $full ) or return;
550 utime time, $entry->mtime - TIME_OFFSET, $full or
551 $self->_error( qq[Could not update timestamp] );
553 if( $CHOWN && CAN_CHOWN ) {
554 chown $entry->uid, $entry->gid, $full or
555 $self->_error( qq[Could not set uid/gid on '$full'] );
558 ### only chmod if we're allowed to, but never chmod symlinks, since they'll
559 ### change the perms on the file they're linking too...
560 if( $CHMOD and not -l $full ) {
561 chmod $entry->mode, $full or
562 $self->_error( qq[Could not chown '$full' to ] . $entry->mode );
568 sub _make_special_file {
570 my $entry = shift or return;
571 my $file = shift; return unless defined $file;
575 if( $entry->is_symlink ) {
578 symlink( $entry->linkname, $file ) or $fail++;
581 $self->_extract_special_file_as_plain_file( $entry, $file )
585 $err = qq[Making symbolink link from '] . $entry->linkname .
586 qq[' to '$file' failed] if $fail;
588 } elsif ( $entry->is_hardlink ) {
591 link( $entry->linkname, $file ) or $fail++;
594 $self->_extract_special_file_as_plain_file( $entry, $file )
598 $err = qq[Making hard link from '] . $entry->linkname .
599 qq[' to '$file' failed] if $fail;
601 } elsif ( $entry->is_fifo ) {
602 ON_UNIX && !system('mknod', $file, 'p') or
603 $err = qq[Making fifo ']. $entry->name .qq[' failed];
605 } elsif ( $entry->is_blockdev or $entry->is_chardev ) {
606 my $mode = $entry->is_blockdev ? 'b' : 'c';
608 ON_UNIX && !system('mknod', $file, $mode,
609 $entry->devmajor, $entry->devminor) or
610 $err = qq[Making block device ']. $entry->name .qq[' (maj=] .
611 $entry->devmajor . qq[ min=] . $entry->devminor .
614 } elsif ( $entry->is_socket ) {
615 ### the original doesn't do anything special for sockets.... ###
619 return $err ? $self->_error( $err ) : 1;
622 ### don't know how to make symlinks, let's just extract the file as
624 sub _extract_special_file_as_plain_file {
626 my $entry = shift or return;
627 my $file = shift; return unless defined $file;
631 my $orig = $self->_find_entry( $entry->linkname );
634 $err = qq[Could not find file '] . $entry->linkname .
639 ### clone the entry, make it appear as a normal file ###
640 my $clone = $entry->clone;
641 $clone->_downgrade_to_plainfile;
642 $self->_extract_file( $clone, $file ) or last TRY;
647 return $self->_error($err);
650 =head2 $tar->list_files( [\@properties] )
652 Returns a list of the names of all the files in the archive.
654 If C<list_files()> is passed an array reference as its first argument
655 it returns a list of hash references containing the requested
656 properties of each file. The following list of properties is
657 supported: name, size, mtime (last modified date), mode, uid, gid,
658 linkname, uname, gname, devmajor, devminor, prefix.
660 Passing an array reference containing only one element, 'name', is
661 special cased to return a list of names rather than a list of hash
662 references, making it equivalent to calling C<list_files> without
669 my $aref = shift || [ ];
671 unless( $self->_data ) {
672 $self->read() or return;
675 if( @$aref == 0 or ( @$aref == 1 and $aref->[0] eq 'name' ) ) {
676 return map { $_->full_path } @{$self->_data};
680 #for my $obj ( @{$self->_data} ) {
681 # push @rv, { map { $_ => $obj->$_() } @$aref };
685 ### this does the same as the above.. just needs a +{ }
686 ### to make sure perl doesn't confuse it for a block
687 return map { my $o=$_;
688 +{ map { $_ => $o->$_() } @$aref }
697 unless( defined $file ) {
698 $self->_error( qq[No file specified] );
702 for my $entry ( @{$self->_data} ) {
703 my $path = $entry->full_path;
704 return $entry if $path eq $file;
707 $self->_error( qq[No such file in archive: '$file'] );
711 =head2 $tar->get_files( [@filenames] )
713 Returns the C<Archive::Tar::File> objects matching the filenames
714 provided. If no filename list was passed, all C<Archive::Tar::File>
715 objects in the current Tar object are returned.
717 Please refer to the C<Archive::Tar::File> documentation on how to
718 handle these objects.
725 return @{ $self->_data } unless @_;
728 for my $file ( @_ ) {
729 push @list, grep { defined } $self->_find_entry( $file );
735 =head2 $tar->get_content( $file )
737 Return the content of the named file.
743 my $entry = $self->_find_entry( shift ) or return;
748 =head2 $tar->replace_content( $file, $content )
750 Make the string $content be the content for the file named $file.
754 sub replace_content {
756 my $entry = $self->_find_entry( shift ) or return;
758 return $entry->replace_content( shift );
761 =head2 $tar->rename( $file, $new_name )
763 Rename the file of the in-memory archive to $new_name.
765 Note that you must specify a Unix path for $new_name, since per tar
766 standard, all files in the archive must be Unix paths.
768 Returns true on success and false on failure.
774 my $file = shift; return unless defined $file;
775 my $new = shift; return unless defined $new;
777 my $entry = $self->_find_entry( $file ) or return;
779 return $entry->rename( $new );
782 =head2 $tar->remove (@filenamelist)
784 Removes any entries with names matching any of the given filenames
785 from the in-memory archive. Returns a list of C<Archive::Tar::File>
794 my %seen = map { $_->full_path => $_ } @{$self->_data};
795 delete $seen{ $_ } for @list;
797 $self->_data( [values %seen] );
804 C<clear> clears the current in-memory archive. This effectively gives
805 you a 'blank' object, ready to be filled again. Note that C<clear>
806 only has effect on the object, not the underlying tarfile.
811 my $self = shift or return;
820 =head2 $tar->write ( [$file, $compressed, $prefix] )
822 Write the in-memory archive to disk. The first argument can either
823 be the name of a file or a reference to an already open filehandle (a
824 GLOB reference). If the second argument is true, the module will use
825 IO::Zlib to write the file in a compressed format. If IO::Zlib is
826 not available, the C<write> method will fail and return.
828 Note that when you pass in a filehandle, the compression argument
829 is ignored, as all files are printed verbatim to your filehandle.
830 If you wish to enable compression with filehandles, use an
831 C<IO::Zlib> filehandle instead.
833 Specific levels of compression can be chosen by passing the values 2
834 through 9 as the second parameter.
836 The third argument is an optional prefix. All files will be tucked
837 away in the directory you specify as prefix. So if you have files
838 'a' and 'b' in your archive, and you specify 'foo' as prefix, they
839 will be written to the archive as 'foo/a' and 'foo/b'.
841 If no arguments are given, C<write> returns the entire formatted
842 archive as a string, which could be useful if you'd like to stuff the
843 archive into a socket or a pipe to gzip or something.
849 my $file = shift; $file = '' unless defined $file;
850 my $gzip = shift || 0;
851 my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix;
854 ### only need a handle if we have a file to print to ###
855 my $handle = length($file)
856 ? ( $self->_get_handle($file, $gzip, WRITE_ONLY->($gzip) )
858 : $HAS_PERLIO ? do { open my $h, '>', \$dummy; $h }
859 : $HAS_IO_STRING ? IO::String->new
860 : __PACKAGE__->no_string_support();
864 for my $entry ( @{$self->_data} ) {
865 ### entries to be written to the tarfile ###
868 ### only now will we change the object to reflect the current state
869 ### of the name and prefix fields -- this needs to be limited to
871 my $clone = $entry->clone;
874 ### so, if you don't want use to use the prefix, we'll stuff
875 ### everything in the name field instead
876 if( $DO_NOT_USE_PREFIX ) {
878 ### you might have an extended prefix, if so, set it in the clone
879 ### XXX is ::Unix right?
880 $clone->name( length $ext_prefix
881 ? File::Spec::Unix->catdir( $ext_prefix,
883 : $clone->full_path );
884 $clone->prefix( '' );
886 ### otherwise, we'll have to set it properly -- prefix part in the
887 ### prefix and name part in the name field.
890 ### split them here, not before!
891 my ($prefix,$name) = $clone->_prefix_and_file( $clone->full_path );
893 ### you might have an extended prefix, if so, set it in the clone
894 ### XXX is ::Unix right?
895 $prefix = File::Spec::Unix->catdir( $ext_prefix, $prefix )
896 if length $ext_prefix;
898 $clone->prefix( $prefix );
899 $clone->name( $name );
902 ### names are too long, and will get truncated if we don't add a
903 ### '@LongLink' file...
904 my $make_longlink = ( length($clone->name) > NAME_LENGTH or
905 length($clone->prefix) > PREFIX_LENGTH
908 ### perhaps we need to make a longlink file?
909 if( $make_longlink ) {
910 my $longlink = Archive::Tar::File->new(
911 data => LONGLINK_NAME,
916 unless( $longlink ) {
917 $self->_error( qq[Could not create 'LongLink' entry for ] .
918 qq[oversize file '] . $clone->full_path ."'" );
922 push @write_me, $longlink;
925 push @write_me, $clone;
927 ### write the one, optionally 2 a::t::file objects to the handle
928 for my $clone (@write_me) {
930 ### if the file is a symlink, there are 2 options:
931 ### either we leave the symlink intact, but then we don't write any
932 ### data OR we follow the symlink, which means we actually make a
933 ### copy. if we do the latter, we have to change the TYPE of the
935 my $link_ok = $clone->is_symlink && $Archive::Tar::FOLLOW_SYMLINK;
936 my $data_ok = !$clone->is_symlink && $clone->has_content;
938 ### downgrade to a 'normal' file if it's a symlink we're going to
939 ### treat as a regular file
940 $clone->_downgrade_to_plainfile if $link_ok;
942 ### get the header for this block
943 my $header = $self->_format_tar_entry( $clone );
945 $self->_error(q[Could not format header for: ] .
950 unless( print $handle $header ) {
951 $self->_error(q[Could not write header for: ] .
956 if( $link_ok or $data_ok ) {
957 unless( print $handle $clone->data ) {
958 $self->_error(q[Could not write data for: ] .
963 ### pad the end of the clone if required ###
964 print $handle TAR_PAD->( $clone->size ) if $clone->size % BLOCK
967 } ### done writing these entries
970 ### write the end markers ###
971 print $handle TAR_END x 2 or
972 return $self->_error( qq[Could not write tar end markers] );
973 ### did you want it written to a file, or returned as a string? ###
974 return length($file) ? 1
975 : $HAS_PERLIO ? $dummy
976 : do { seek $handle, 0, 0; local $/; <$handle> }
979 sub _format_tar_entry {
981 my $entry = shift or return;
982 my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix;
983 my $no_prefix = shift || 0;
985 my $file = $entry->name;
986 my $prefix = $entry->prefix; $prefix = '' unless defined $prefix;
988 ### remove the prefix from the file name
989 ### not sure if this is still neeeded --kane
990 ### no it's not -- Archive::Tar::File->_new_from_file will take care of
991 ### this for us. Even worse, this would break if we tried to add a file
993 #if( length $prefix ) {
994 # $file =~ s/^$match//;
997 $prefix = File::Spec::Unix->catdir($ext_prefix, $prefix)
998 if length $ext_prefix;
1000 ### not sure why this is... ###
1001 my $l = PREFIX_LENGTH; # is ambiguous otherwise...
1002 substr ($prefix, 0, -$l) = "" if length $prefix >= PREFIX_LENGTH;
1004 my $f1 = "%06o"; my $f2 = "%11o";
1006 ### this might be optimizable with a 'changed' flag in the file objects ###
1011 (map { sprintf( $f1, $entry->$_() ) } qw[mode uid gid]),
1012 (map { sprintf( $f2, $entry->$_() ) } qw[size mtime]),
1014 "", # checksum field - space padded a bit down
1016 (map { $entry->$_() } qw[type linkname magic]),
1018 $entry->version || TAR_VERSION,
1020 (map { $entry->$_() } qw[uname gname]),
1021 (map { sprintf( $f1, $entry->$_() ) } qw[devmajor devminor]),
1023 ($no_prefix ? '' : $prefix)
1026 ### add the checksum ###
1027 substr($tar,148,7) = sprintf("%6o\0", unpack("%16C*",$tar));
1032 =head2 $tar->add_files( @filenamelist )
1034 Takes a list of filenames and adds them to the in-memory archive.
1036 The path to the file is automatically converted to a Unix like
1037 equivalent for use in the archive, and, if on MacOS, the file's
1038 modification time is converted from the MacOS epoch to the Unix epoch.
1039 So tar archives created on MacOS with B<Archive::Tar> can be read
1040 both with I<tar> on Unix and applications like I<suntar> or
1041 I<Stuffit Expander> on MacOS.
1043 Be aware that the file's type/creator and resource fork will be lost,
1044 which is usually what you want in cross-platform archives.
1046 Returns a list of C<Archive::Tar::File> objects that were just added.
1052 my @files = @_ or return;
1055 for my $file ( @files ) {
1056 unless( -e $file ) {
1057 $self->_error( qq[No such file: '$file'] );
1061 my $obj = Archive::Tar::File->new( file => $file );
1063 $self->_error( qq[Unable to add file: '$file'] );
1070 push @{$self->{_data}}, @rv;
1075 =head2 $tar->add_data ( $filename, $data, [$opthashref] )
1077 Takes a filename, a scalar full of data and optionally a reference to
1078 a hash with specific options.
1080 Will add a file to the in-memory archive, with name C<$filename> and
1081 content C<$data>. Specific properties can be set using C<$opthashref>.
1082 The following list of properties is supported: name, size, mtime
1083 (last modified date), mode, uid, gid, linkname, uname, gname,
1084 devmajor, devminor, prefix. (On MacOS, the file's path and
1085 modification times are converted to Unix equivalents.)
1087 Returns the C<Archive::Tar::File> object that was just added, or
1088 C<undef> on failure.
1094 my ($file, $data, $opt) = @_;
1096 my $obj = Archive::Tar::File->new( data => $file, $data, $opt );
1098 $self->_error( qq[Unable to add file: '$file'] );
1102 push @{$self->{_data}}, $obj;
1107 =head2 $tar->error( [$BOOL] )
1109 Returns the current errorstring (usually, the last error reported).
1110 If a true value was specified, it will give the C<Carp::longmess>
1111 equivalent of the error, in effect giving you a stacktrace.
1113 For backwards compatibility, this error is also available as
1114 C<$Archive::Tar::error> although it is much recommended you use the
1115 method call instead.
1125 my $msg = $error = shift;
1126 $longmess = Carp::longmess($error);
1128 ### set Archive::Tar::WARN to 0 to disable printing
1131 carp $DEBUG ? $longmess : $msg;
1139 return shift() ? $longmess : $error;
1144 =head2 $bool = $tar->has_io_string
1146 Returns true if we currently have C<IO::String> support loaded.
1148 Either C<IO::String> or C<perlio> support is needed to support writing
1149 stringified archives. Currently, C<perlio> is the preffered method, if
1152 See the C<GLOBAL VARIABLES> section to see how to change this preference.
1156 sub has_io_string { return $HAS_IO_STRING; }
1158 =head2 $bool = $tar->has_perlio
1160 Returns true if we currently have C<perlio> support loaded.
1162 This requires C<perl-5.8> or higher, compiled with C<perlio>
1164 Either C<IO::String> or C<perlio> support is needed to support writing
1165 stringified archives. Currently, C<perlio> is the preffered method, if
1168 See the C<GLOBAL VARIABLES> section to see how to change this preference.
1172 sub has_perlio { return $HAS_PERLIO; }
1175 =head1 Class Methods
1177 =head2 Archive::Tar->create_archive($file, $compression, @filelist)
1179 Creates a tar file from the list of files provided. The first
1180 argument can either be the name of the tar file to create or a
1181 reference to an open file handle (e.g. a GLOB reference).
1183 The second argument specifies the level of compression to be used, if
1184 any. Compression of tar files requires the installation of the
1185 IO::Zlib module. Specific levels of compression may be
1186 requested by passing a value between 2 and 9 as the second argument.
1187 Any other value evaluating as true will result in the default
1188 compression level being used.
1190 Note that when you pass in a filehandle, the compression argument
1191 is ignored, as all files are printed verbatim to your filehandle.
1192 If you wish to enable compression with filehandles, use an
1193 C<IO::Zlib> filehandle instead.
1195 The remaining arguments list the files to be included in the tar file.
1196 These files must all exist. Any files which don't exist or can't be
1197 read are silently ignored.
1199 If the archive creation fails for any reason, C<create_archive> will
1200 return false. Please use the C<error> method to find the cause of the
1203 Note that this method does not write C<on the fly> as it were; it
1204 still reads all the files into memory before writing out the archive.
1205 Consult the FAQ below if this is a problem.
1209 sub create_archive {
1212 my $file = shift; return unless defined $file;
1213 my $gzip = shift || 0;
1217 return $class->_error( qq[Cowardly refusing to create empty archive!] );
1220 my $tar = $class->new;
1221 $tar->add_files( @files );
1222 return $tar->write( $file, $gzip );
1225 =head2 Archive::Tar->list_archive ($file, $compressed, [\@properties])
1227 Returns a list of the names of all the files in the archive. The
1228 first argument can either be the name of the tar file to list or a
1229 reference to an open file handle (e.g. a GLOB reference).
1231 If C<list_archive()> is passed an array reference as its third
1232 argument it returns a list of hash references containing the requested
1233 properties of each file. The following list of properties is
1234 supported: name, size, mtime (last modified date), mode, uid, gid,
1235 linkname, uname, gname, devmajor, devminor, prefix.
1237 Passing an array reference containing only one element, 'name', is
1238 special cased to return a list of names rather than a list of hash
1245 my $file = shift; return unless defined $file;
1246 my $gzip = shift || 0;
1248 my $tar = $class->new($file, $gzip);
1251 return $tar->list_files( @_ );
1254 =head2 Archive::Tar->extract_archive ($file, $gzip)
1256 Extracts the contents of the tar file. The first argument can either
1257 be the name of the tar file to create or a reference to an open file
1258 handle (e.g. a GLOB reference). All relative paths in the tar file will
1259 be created underneath the current working directory.
1261 C<extract_archive> will return a list of files it extracted.
1262 If the archive extraction fails for any reason, C<extract_archive>
1263 will return false. Please use the C<error> method to find the cause
1268 sub extract_archive {
1270 my $file = shift; return unless defined $file;
1271 my $gzip = shift || 0;
1273 my $tar = $class->new( ) or return;
1275 return $tar->read( $file, $gzip, { extract => 1 } );
1278 =head2 Archive::Tar->can_handle_compressed_files
1280 A simple checking routine, which will return true if C<Archive::Tar>
1281 is able to uncompress compressed archives on the fly with C<IO::Zlib>,
1282 or false if C<IO::Zlib> is not installed.
1284 You can use this as a shortcut to determine whether C<Archive::Tar>
1285 will do what you think before passing compressed archives to its
1290 sub can_handle_compressed_files { return ZLIB ? 1 : 0 }
1292 sub no_string_support {
1293 croak("You have to install IO::String to support writing archives to strings");
1300 =head1 GLOBAL VARIABLES
1302 =head2 $Archive::Tar::FOLLOW_SYMLINK
1304 Set this variable to C<1> to make C<Archive::Tar> effectively make a
1305 copy of the file when extracting. Default is C<0>, which
1306 means the symlink stays intact. Of course, you will have to pack the
1307 file linked to as well.
1309 This option is checked when you write out the tarfile using C<write>
1310 or C<create_archive>.
1312 This works just like C</bin/tar>'s C<-h> option.
1314 =head2 $Archive::Tar::CHOWN
1316 By default, C<Archive::Tar> will try to C<chown> your files if it is
1317 able to. In some cases, this may not be desired. In that case, set
1318 this variable to C<0> to disable C<chown>-ing, even if it were
1321 The default is C<1>.
1323 =head2 $Archive::Tar::CHMOD
1325 By default, C<Archive::Tar> will try to C<chmod> your files to
1326 whatever mode was specified for the particular file in the archive.
1327 In some cases, this may not be desired. In that case, set this
1328 variable to C<0> to disable C<chmod>-ing.
1330 The default is C<1>.
1332 =head2 $Archive::Tar::DO_NOT_USE_PREFIX
1334 By default, C<Archive::Tar> will try to put paths that are over
1335 100 characters in the C<prefix> field of your tar header. However,
1336 some older tar programs do not implement this spec. To retain
1337 compatibility with these older versions, you can set the
1338 C<$DO_NOT_USE_PREFIX> variable to a true value, and C<Archive::Tar>
1339 will use an alternate way of dealing with paths over 100 characters
1340 by using the C<GNU Extended Header> feature.
1342 The default is C<0>.
1344 =head2 $Archive::Tar::DEBUG
1346 Set this variable to C<1> to always get the C<Carp::longmess> output
1347 of the warnings, instead of the regular C<carp>. This is the same
1348 message you would get by doing:
1354 =head2 $Archive::Tar::WARN
1356 Set this variable to C<0> if you do not want any warnings printed.
1357 Personally I recommend against doing this, but people asked for the
1358 option. Also, be advised that this is of course not threadsafe.
1362 =head2 $Archive::Tar::error
1364 Holds the last reported error. Kept for historical reasons, but its
1365 use is very much discouraged. Use the C<error()> method instead:
1367 warn $tar->error unless $tar->extract;
1369 =head2 $Archive::Tar::HAS_PERLIO
1371 This variable holds a boolean indicating if we currently have
1372 C<perlio> support loaded. This will be enabled for any perl
1373 greater than C<5.8> compiled with C<perlio>.
1375 If you feel strongly about disabling it, set this variable to
1376 C<false>. Note that you will then need C<IO::String> installed
1377 to support writing stringified archives.
1379 Don't change this variable unless you B<really> know what you're
1382 =head2 $Archive::Tar::HAS_IO_STRING
1384 This variable holds a boolean indicating if we currently have
1385 C<IO::String> support loaded. This will be enabled for any perl
1386 that has a loadable C<IO::String> module.
1388 If you feel strongly about disabling it, set this variable to
1389 C<false>. Note that you will then need C<perlio> support from
1390 your perl to be able to write stringified archives.
1392 Don't change this variable unless you B<really> know what you're
1399 =item What's the minimum perl version required to run Archive::Tar?
1401 You will need perl version 5.005_03 or newer.
1403 =item Isn't Archive::Tar slow?
1405 Yes it is. It's pure perl, so it's a lot slower then your C</bin/tar>
1406 However, it's very portable. If speed is an issue, consider using
1407 C</bin/tar> instead.
1409 =item Isn't Archive::Tar heavier on memory than /bin/tar?
1411 Yes it is, see previous answer. Since C<Compress::Zlib> and therefore
1412 C<IO::Zlib> doesn't support C<seek> on their filehandles, there is little
1413 choice but to read the archive into memory.
1414 This is ok if you want to do in-memory manipulation of the archive.
1415 If you just want to extract, use the C<extract_archive> class method
1416 instead. It will optimize and write to disk immediately.
1418 =item Can't you lazy-load data instead?
1420 No, not easily. See previous question.
1422 =item How much memory will an X kb tar file need?
1424 Probably more than X kb, since it will all be read into memory. If
1425 this is a problem, and you don't need to do in memory manipulation
1426 of the archive, consider using C</bin/tar> instead.
1428 =item What do you do with unsupported filetypes in an archive?
1430 C<Unix> has a few filetypes that aren't supported on other platforms,
1431 like C<Win32>. If we encounter a C<hardlink> or C<symlink> we'll just
1432 try to make a copy of the original file, rather than throwing an error.
1434 This does require you to read the entire archive in to memory first,
1435 since otherwise we wouldn't know what data to fill the copy with.
1436 (This means that you cannot use the class methods on archives that
1437 have incompatible filetypes and still expect things to work).
1439 For other filetypes, like C<chardevs> and C<blockdevs> we'll warn that
1440 the extraction of this particular item didn't work.
1448 =item Check if passed in handles are open for read/write
1450 Currently I don't know of any portable pure perl way to do this.
1451 Suggestions welcome.
1458 Jos Boumans E<lt>kane@cpan.orgE<gt>.
1460 =head1 ACKNOWLEDGEMENTS
1462 Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney and
1463 especially Andrew Savige for their help and suggestions.
1468 copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
1469 All rights reserved.
1471 This library is free software;
1472 you may redistribute and/or modify it under the same
1473 terms as Perl itself.