Move all the compile time options that affect binary compatibility into
[p5sagit/p5-mst-13.2.git] / lib / Archive / Tar.pm
CommitLineData
39713df4 1### the gnu tar specification:
f38c1908 2### http://www.gnu.org/software/tar/manual/tar.html
39713df4 3###
4### and the pax format spec, which tar derives from:
5### http://www.opengroup.org/onlinepubs/007904975/utilities/pax.html
6
7package Archive::Tar;
8require 5.005_03;
9
10use strict;
11use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
12 $DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING];
13
14$DEBUG = 0;
15$WARN = 1;
16$FOLLOW_SYMLINK = 0;
48e76d2d 17$VERSION = "1.34_01";
39713df4 18$CHOWN = 1;
19$CHMOD = 1;
20$DO_NOT_USE_PREFIX = 0;
21
22BEGIN {
23 use Config;
24 $HAS_PERLIO = $Config::Config{useperlio};
25
26 ### try and load IO::String anyway, so you can dynamically
27 ### switch between perlio and IO::String
28 eval {
29 require IO::String;
30 import IO::String;
31 };
32 $HAS_IO_STRING = $@ ? 0 : 1;
33
34}
35
36use Cwd;
37use IO::File;
38use Carp qw(carp croak);
39use File::Spec ();
40use File::Spec::Unix ();
41use File::Path ();
42
43use Archive::Tar::File;
44use Archive::Tar::Constant;
45
46=head1 NAME
47
48Archive::Tar - module for manipulations of tar archives
49
50=head1 SYNOPSIS
51
52 use Archive::Tar;
53 my $tar = Archive::Tar->new;
54
55 $tar->read('origin.tgz',1);
56 $tar->extract();
57
58 $tar->add_files('file/foo.pl', 'docs/README');
59 $tar->add_data('file/baz.txt', 'This is the contents now');
60
61 $tar->rename('oldname', 'new/file/name');
62
63 $tar->write('files.tar');
64
65=head1 DESCRIPTION
66
67Archive::Tar provides an object oriented mechanism for handling tar
68files. It provides class methods for quick and easy files handling
69while also allowing for the creation of tar file objects for custom
70manipulation. If you have the IO::Zlib module installed,
71Archive::Tar will also support compressed or gzipped tar files.
72
73An object of class Archive::Tar represents a .tar(.gz) archive full
74of files and things.
75
76=head1 Object Methods
77
78=head2 Archive::Tar->new( [$file, $compressed] )
79
80Returns a new Tar object. If given any arguments, C<new()> calls the
81C<read()> method automatically, passing on the arguments provided to
82the C<read()> method.
83
84If C<new()> is invoked with arguments and the C<read()> method fails
85for any reason, C<new()> returns undef.
86
87=cut
88
89my $tmpl = {
90 _data => [ ],
91 _file => 'Unknown',
92};
93
94### install get/set accessors for this object.
95for my $key ( keys %$tmpl ) {
96 no strict 'refs';
97 *{__PACKAGE__."::$key"} = sub {
98 my $self = shift;
99 $self->{$key} = $_[0] if @_;
100 return $self->{$key};
101 }
102}
103
104sub new {
105 my $class = shift;
106 $class = ref $class if ref $class;
107
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;
111
112 if (@_) {
81a5970e 113 unless ( $obj->read( @_ ) ) {
114 $obj->_error(qq[No data could be read from file]);
115 return;
116 }
39713df4 117 }
118
119 return $obj;
120}
121
122=head2 $tar->read ( $filename|$handle, $compressed, {opt => 'val'} )
123
124Read the given tar file into memory.
125The first argument can either be the name of a file or a reference to
126an already open filehandle (or an IO::Zlib object if it's compressed)
127The second argument indicates whether the file referenced by the first
128argument is compressed.
129
130The C<read> will I<replace> any previous content in C<$tar>!
131
132The second argument may be considered optional if IO::Zlib is
133installed, since it will transparently Do The Right Thing.
134Archive::Tar will warn if you try to pass a compressed file if
135IO::Zlib is not available and simply return.
136
b3200c5d 137Note that you can currently B<not> pass a C<gzip> compressed
138filehandle, which is not opened with C<IO::Zlib>, nor a string
139containing the full archive information (either compressed or
140uncompressed). These are worth while features, but not currently
141implemented. See the C<TODO> section.
142
39713df4 143The third argument can be a hash reference with options. Note that
144all options are case-sensitive.
145
146=over 4
147
148=item limit
149
150Do not read more than C<limit> files. This is useful if you have
151very big archives, and are only interested in the first few files.
152
153=item extract
154
155If set to true, immediately extract entries when reading them. This
156gives you the same memory break as the C<extract_archive> function.
157Note however that entries will not be read into memory, but written
158straight to disk.
159
160=back
161
162All files are stored internally as C<Archive::Tar::File> objects.
163Please consult the L<Archive::Tar::File> documentation for details.
164
165Returns the number of files read in scalar context, and a list of
166C<Archive::Tar::File> objects in list context.
167
168=cut
169
170sub read {
171 my $self = shift;
172 my $file = shift;
173 my $gzip = shift || 0;
174 my $opts = shift || {};
175
176 unless( defined $file ) {
177 $self->_error( qq[No file to read from!] );
178 return;
179 } else {
180 $self->_file( $file );
181 }
182
183 my $handle = $self->_get_handle($file, $gzip, READ_ONLY->( ZLIB ) )
184 or return;
185
186 my $data = $self->_read_tar( $handle, $opts ) or return;
187
188 $self->_data( $data );
189
190 return wantarray ? @$data : scalar @$data;
191}
192
193sub _get_handle {
194 my $self = shift;
195 my $file = shift; return unless defined $file;
196 return $file if ref $file;
197
198 my $gzip = shift || 0;
199 my $mode = shift || READ_ONLY->( ZLIB ); # default to read only
200
201 my $fh; my $bin;
202
203 ### only default to ZLIB if we're not trying to /write/ to a handle ###
204 if( ZLIB and $gzip || MODE_READ->( $mode ) ) {
205
206 ### IO::Zlib will Do The Right Thing, even when passed
207 ### a plain file ###
208 $fh = new IO::Zlib;
209
210 } else {
211 if( $gzip ) {
212 $self->_error(qq[Compression not available - Install IO::Zlib!]);
213 return;
214
215 } else {
216 $fh = new IO::File;
217 $bin++;
218 }
219 }
220
221 unless( $fh->open( $file, $mode ) ) {
222 $self->_error( qq[Could not create filehandle for '$file': $!!] );
223 return;
224 }
225
226 binmode $fh if $bin;
227
228 return $fh;
229}
230
231sub _read_tar {
232 my $self = shift;
233 my $handle = shift or return;
234 my $opts = shift || {};
235
236 my $count = $opts->{limit} || 0;
237 my $extract = $opts->{extract} || 0;
238
239 ### set a cap on the amount of files to extract ###
240 my $limit = 0;
241 $limit = 1 if $count > 0;
242
243 my $tarfile = [ ];
244 my $chunk;
245 my $read = 0;
246 my $real_name; # to set the name of a file when
247 # we're encountering @longlink
248 my $data;
249
250 LOOP:
251 while( $handle->read( $chunk, HEAD ) ) {
252 ### IO::Zlib doesn't support this yet
253 my $offset = eval { tell $handle } || 'unknown';
254
255 unless( $read++ ) {
256 my $gzip = GZIP_MAGIC_NUM;
257 if( $chunk =~ /$gzip/ ) {
258 $self->_error( qq[Cannot read compressed format in tar-mode] );
259 return;
260 }
261 }
262
263 ### if we can't read in all bytes... ###
264 last if length $chunk != HEAD;
265
266 ### Apparently this should really be two blocks of 512 zeroes,
267 ### but GNU tar sometimes gets it wrong. See comment in the
268 ### source code (tar.c) to GNU cpio.
269 next if $chunk eq TAR_END;
270
b30bcf62 271 ### according to the posix spec, the last 12 bytes of the header are
272 ### null bytes, to pad it to a 512 byte block. That means if these
273 ### bytes are NOT null bytes, it's a corrrupt header. See:
274 ### www.koders.com/c/fidCE473AD3D9F835D690259D60AD5654591D91D5BA.aspx
275 ### line 111
276 { my $nulls = join '', "\0" x 12;
277 unless( $nulls eq substr( $chunk, 500, 12 ) ) {
278 $self->_error( qq[Invalid header block at offset $offset] );
279 next LOOP;
280 }
281 }
282
81a5970e 283 ### pass the realname, so we can set it 'proper' right away
284 ### some of the heuristics are done on the name, so important
285 ### to set it ASAP
39713df4 286 my $entry;
81a5970e 287 { my %extra_args = ();
288 $extra_args{'name'} = $$real_name if defined $real_name;
289
290 unless( $entry = Archive::Tar::File->new( chunk => $chunk,
291 %extra_args )
292 ) {
293 $self->_error( qq[Couldn't read chunk at offset $offset] );
b30bcf62 294 next LOOP;
81a5970e 295 }
39713df4 296 }
297
298 ### ignore labels:
299 ### http://www.gnu.org/manual/tar/html_node/tar_139.html
300 next if $entry->is_label;
301
302 if( length $entry->type and ($entry->is_file || $entry->is_longlink) ) {
303
304 if ( $entry->is_file && !$entry->validate ) {
305 ### sometimes the chunk is rather fux0r3d and a whole 512
c3745331 306 ### bytes ends up in the ->name area.
39713df4 307 ### clean it up, if need be
308 my $name = $entry->name;
309 $name = substr($name, 0, 100) if length $name > 100;
310 $name =~ s/\n/ /g;
311
312 $self->_error( $name . qq[: checksum error] );
313 next LOOP;
314 }
315
316 my $block = BLOCK_SIZE->( $entry->size );
317
318 $data = $entry->get_content_by_ref;
319
320 ### just read everything into memory
321 ### can't do lazy loading since IO::Zlib doesn't support 'seek'
322 ### this is because Compress::Zlib doesn't support it =/
323 ### this reads in the whole data in one read() call.
324 if( $handle->read( $$data, $block ) < $block ) {
325 $self->_error( qq[Read error on tarfile (missing data) '].
326 $entry->full_path ."' at offset $offset" );
b30bcf62 327 next LOOP;
39713df4 328 }
329
330 ### throw away trailing garbage ###
376cc5ea 331 substr ($$data, $entry->size) = "" if defined $$data;
39713df4 332
333 ### part II of the @LongLink munging -- need to do /after/
334 ### the checksum check.
335 if( $entry->is_longlink ) {
336 ### weird thing in tarfiles -- if the file is actually a
337 ### @LongLink, the data part seems to have a trailing ^@
338 ### (unprintable) char. to display, pipe output through less.
339 ### but that doesn't *always* happen.. so check if the last
340 ### character is a control character, and if so remove it
341 ### at any rate, we better remove that character here, or tests
342 ### like 'eq' and hashlook ups based on names will SO not work
343 ### remove it by calculating the proper size, and then
344 ### tossing out everything that's longer than that size.
345
346 ### count number of nulls
347 my $nulls = $$data =~ tr/\0/\0/;
348
349 ### cut data + size by that many bytes
350 $entry->size( $entry->size - $nulls );
351 substr ($$data, $entry->size) = "";
352 }
353 }
354
355 ### clean up of the entries.. posix tar /apparently/ has some
356 ### weird 'feature' that allows for filenames > 255 characters
357 ### they'll put a header in with as name '././@LongLink' and the
358 ### contents will be the name of the /next/ file in the archive
359 ### pretty crappy and kludgy if you ask me
360
361 ### set the name for the next entry if this is a @LongLink;
362 ### this is one ugly hack =/ but needed for direct extraction
363 if( $entry->is_longlink ) {
364 $real_name = $data;
b30bcf62 365 next LOOP;
39713df4 366 } elsif ( defined $real_name ) {
367 $entry->name( $$real_name );
368 $entry->prefix('');
369 undef $real_name;
370 }
371
372 $self->_extract_file( $entry ) if $extract
373 && !$entry->is_longlink
374 && !$entry->is_unknown
375 && !$entry->is_label;
376
377 ### Guard against tarfiles with garbage at the end
378 last LOOP if $entry->name eq '';
379
380 ### push only the name on the rv if we're extracting
381 ### -- for extract_archive
382 push @$tarfile, ($extract ? $entry->name : $entry);
383
384 if( $limit ) {
385 $count-- unless $entry->is_longlink || $entry->is_dir;
386 last LOOP unless $count;
387 }
388 } continue {
389 undef $data;
390 }
391
392 return $tarfile;
393}
394
395=head2 $tar->contains_file( $filename )
396
397Check if the archive contains a certain file.
398It will return true if the file is in the archive, false otherwise.
399
400Note however, that this function does an exact match using C<eq>
401on the full path. So it cannot compensate for case-insensitive file-
402systems or compare 2 paths to see if they would point to the same
403underlying file.
404
405=cut
406
407sub contains_file {
408 my $self = shift;
01d11a1c 409 my $full = shift;
410
411 return unless defined $full;
39713df4 412
c3745331 413 ### don't warn if the entry isn't there.. that's what this function
414 ### is for after all.
415 local $WARN = 0;
39713df4 416 return 1 if $self->_find_entry($full);
417 return;
418}
419
420=head2 $tar->extract( [@filenames] )
421
422Write files whose names are equivalent to any of the names in
423C<@filenames> to disk, creating subdirectories as necessary. This
424might not work too well under VMS.
425Under MacPerl, the file's modification time will be converted to the
426MacOS zero of time, and appropriate conversions will be done to the
427path. However, the length of each element of the path is not
428inspected to see whether it's longer than MacOS currently allows (32
429characters).
430
431If C<extract> is called without a list of file names, the entire
432contents of the archive are extracted.
433
434Returns a list of filenames extracted.
435
436=cut
437
438sub extract {
439 my $self = shift;
b30bcf62 440 my @args = @_;
39713df4 441 my @files;
442
f38c1908 443 # use the speed optimization for all extracted files
444 local($self->{cwd}) = cwd() unless $self->{cwd};
445
39713df4 446 ### you requested the extraction of only certian files
b30bcf62 447 if( @args ) {
448 for my $file ( @args ) {
449
450 ### it's already an object?
451 if( UNIVERSAL::isa( $file, 'Archive::Tar::File' ) ) {
452 push @files, $file;
453 next;
39713df4 454
b30bcf62 455 ### go find it then
456 } else {
457
458 my $found;
459 for my $entry ( @{$self->_data} ) {
460 next unless $file eq $entry->full_path;
461
462 ### we found the file you're looking for
463 push @files, $entry;
464 $found++;
465 }
466
467 unless( $found ) {
468 return $self->_error(
469 qq[Could not find '$file' in archive] );
470 }
39713df4 471 }
472 }
473
474 ### just grab all the file items
475 } else {
476 @files = $self->get_files;
477 }
478
479 ### nothing found? that's an error
480 unless( scalar @files ) {
481 $self->_error( qq[No files found for ] . $self->_file );
482 return;
483 }
484
485 ### now extract them
486 for my $entry ( @files ) {
487 unless( $self->_extract_file( $entry ) ) {
488 $self->_error(q[Could not extract ']. $entry->full_path .q['] );
489 return;
490 }
491 }
492
493 return @files;
494}
495
496=head2 $tar->extract_file( $file, [$extract_path] )
497
498Write an entry, whose name is equivalent to the file name provided to
48e76d2d 499disk. Optionally takes a second parameter, which is the full native
39713df4 500path (including filename) the entry will be written to.
501
502For example:
503
504 $tar->extract_file( 'name/in/archive', 'name/i/want/to/give/it' );
505
b30bcf62 506 $tar->extract_file( $at_file_object, 'name/i/want/to/give/it' );
507
39713df4 508Returns true on success, false on failure.
509
510=cut
511
512sub extract_file {
513 my $self = shift;
01d11a1c 514 my $file = shift; return unless defined $file;
39713df4 515 my $alt = shift;
516
517 my $entry = $self->_find_entry( $file )
518 or $self->_error( qq[Could not find an entry for '$file'] ), return;
519
520 return $self->_extract_file( $entry, $alt );
521}
522
523sub _extract_file {
524 my $self = shift;
525 my $entry = shift or return;
526 my $alt = shift;
39713df4 527
528 ### you wanted an alternate extraction location ###
529 my $name = defined $alt ? $alt : $entry->full_path;
530
531 ### splitpath takes a bool at the end to indicate
532 ### that it's splitting a dir
7f10f74b 533 my ($vol,$dirs,$file);
534 if ( defined $alt ) { # It's a local-OS path
535 ($vol,$dirs,$file) = File::Spec->splitpath( $alt,
536 $entry->is_dir );
537 } else {
538 ($vol,$dirs,$file) = File::Spec::Unix->splitpath( $name,
539 $entry->is_dir );
540 }
541
39713df4 542 my $dir;
543 ### is $name an absolute path? ###
544 if( File::Spec->file_name_is_absolute( $dirs ) ) {
545 $dir = $dirs;
546
547 ### it's a relative path ###
548 } else {
f38c1908 549 my $cwd = (defined $self->{cwd} ? $self->{cwd} : cwd());
48e76d2d 550 my @dirs;
551 if ( defined $alt ) { # It's a local-OS path
552 @dirs = File::Spec->splitdir( $dirs );
553 } else { # it's UNIX-style, likely straight from the tarball
554 @dirs = File::Spec::Unix->splitdir( $dirs );
555 }
556 map tr/\./_/, @dirs if $^O eq 'VMS'; # '.' is the directory delimiter
557 my ($cwd_vol,$cwd_dir,$cwd_file)
558 = File::Spec->splitpath( $cwd );
559 my @cwd = File::Spec->splitdir( $cwd_dir );
560 push @cwd, $cwd_file if length $cwd_file;
561 $dir = File::Spec->catpath( $cwd_vol, File::Spec->catdir( @cwd, @dirs ) );
81a5970e 562
563 # catdir() returns undef if the path is longer than 255 chars on VMS
564 unless ( defined $dir ) {
565 $^W && $self->_error( qq[Could not compose a path for '$dirs'\n] );
566 return;
567 }
568
39713df4 569 }
570
571 if( -e $dir && !-d _ ) {
572 $^W && $self->_error( qq['$dir' exists, but it's not a directory!\n] );
573 return;
574 }
575
576 unless ( -d _ ) {
577 eval { File::Path::mkpath( $dir, 0, 0777 ) };
578 if( $@ ) {
579 $self->_error( qq[Could not create directory '$dir': $@] );
580 return;
581 }
c3745331 582
583 ### XXX chown here? that might not be the same as in the archive
584 ### as we're only chown'ing to the owner of the file we're extracting
585 ### not to the owner of the directory itself, which may or may not
586 ### be another entry in the archive
587 ### Answer: no, gnu tar doesn't do it either, it'd be the wrong
588 ### way to go.
589 #if( $CHOWN && CAN_CHOWN ) {
590 # chown $entry->uid, $entry->gid, $dir or
591 # $self->_error( qq[Could not set uid/gid on '$dir'] );
592 #}
39713df4 593 }
594
595 ### we're done if we just needed to create a dir ###
596 return 1 if $entry->is_dir;
597
598 my $full = File::Spec->catfile( $dir, $file );
599
600 if( $entry->is_unknown ) {
601 $self->_error( qq[Unknown file type for file '$full'] );
602 return;
603 }
604
605 if( length $entry->type && $entry->is_file ) {
606 my $fh = IO::File->new;
607 $fh->open( '>' . $full ) or (
608 $self->_error( qq[Could not open file '$full': $!] ),
609 return
610 );
611
612 if( $entry->size ) {
613 binmode $fh;
614 syswrite $fh, $entry->data or (
615 $self->_error( qq[Could not write data to '$full'] ),
616 return
617 );
618 }
619
620 close $fh or (
621 $self->_error( qq[Could not close file '$full'] ),
622 return
623 );
624
625 } else {
626 $self->_make_special_file( $entry, $full ) or return;
627 }
628
629 utime time, $entry->mtime - TIME_OFFSET, $full or
630 $self->_error( qq[Could not update timestamp] );
631
632 if( $CHOWN && CAN_CHOWN ) {
633 chown $entry->uid, $entry->gid, $full or
634 $self->_error( qq[Could not set uid/gid on '$full'] );
635 }
636
637 ### only chmod if we're allowed to, but never chmod symlinks, since they'll
638 ### change the perms on the file they're linking too...
639 if( $CHMOD and not -l $full ) {
640 chmod $entry->mode, $full or
641 $self->_error( qq[Could not chown '$full' to ] . $entry->mode );
642 }
643
644 return 1;
645}
646
647sub _make_special_file {
648 my $self = shift;
649 my $entry = shift or return;
650 my $file = shift; return unless defined $file;
651
652 my $err;
653
654 if( $entry->is_symlink ) {
655 my $fail;
656 if( ON_UNIX ) {
657 symlink( $entry->linkname, $file ) or $fail++;
658
659 } else {
660 $self->_extract_special_file_as_plain_file( $entry, $file )
661 or $fail++;
662 }
663
664 $err = qq[Making symbolink link from '] . $entry->linkname .
665 qq[' to '$file' failed] if $fail;
666
667 } elsif ( $entry->is_hardlink ) {
668 my $fail;
669 if( ON_UNIX ) {
670 link( $entry->linkname, $file ) or $fail++;
671
672 } else {
673 $self->_extract_special_file_as_plain_file( $entry, $file )
674 or $fail++;
675 }
676
677 $err = qq[Making hard link from '] . $entry->linkname .
678 qq[' to '$file' failed] if $fail;
679
680 } elsif ( $entry->is_fifo ) {
681 ON_UNIX && !system('mknod', $file, 'p') or
682 $err = qq[Making fifo ']. $entry->name .qq[' failed];
683
684 } elsif ( $entry->is_blockdev or $entry->is_chardev ) {
685 my $mode = $entry->is_blockdev ? 'b' : 'c';
686
687 ON_UNIX && !system('mknod', $file, $mode,
688 $entry->devmajor, $entry->devminor) or
689 $err = qq[Making block device ']. $entry->name .qq[' (maj=] .
690 $entry->devmajor . qq[ min=] . $entry->devminor .
691 qq[) failed.];
692
693 } elsif ( $entry->is_socket ) {
694 ### the original doesn't do anything special for sockets.... ###
695 1;
696 }
697
698 return $err ? $self->_error( $err ) : 1;
699}
700
701### don't know how to make symlinks, let's just extract the file as
702### a plain file
703sub _extract_special_file_as_plain_file {
704 my $self = shift;
705 my $entry = shift or return;
706 my $file = shift; return unless defined $file;
707
708 my $err;
709 TRY: {
710 my $orig = $self->_find_entry( $entry->linkname );
711
712 unless( $orig ) {
713 $err = qq[Could not find file '] . $entry->linkname .
714 qq[' in memory.];
715 last TRY;
716 }
717
718 ### clone the entry, make it appear as a normal file ###
719 my $clone = $entry->clone;
720 $clone->_downgrade_to_plainfile;
721 $self->_extract_file( $clone, $file ) or last TRY;
722
723 return 1;
724 }
725
726 return $self->_error($err);
727}
728
729=head2 $tar->list_files( [\@properties] )
730
731Returns a list of the names of all the files in the archive.
732
733If C<list_files()> is passed an array reference as its first argument
734it returns a list of hash references containing the requested
735properties of each file. The following list of properties is
736supported: name, size, mtime (last modified date), mode, uid, gid,
737linkname, uname, gname, devmajor, devminor, prefix.
738
739Passing an array reference containing only one element, 'name', is
740special cased to return a list of names rather than a list of hash
741references, making it equivalent to calling C<list_files> without
742arguments.
743
744=cut
745
746sub list_files {
747 my $self = shift;
748 my $aref = shift || [ ];
749
750 unless( $self->_data ) {
751 $self->read() or return;
752 }
753
754 if( @$aref == 0 or ( @$aref == 1 and $aref->[0] eq 'name' ) ) {
755 return map { $_->full_path } @{$self->_data};
756 } else {
757
758 #my @rv;
759 #for my $obj ( @{$self->_data} ) {
760 # push @rv, { map { $_ => $obj->$_() } @$aref };
761 #}
762 #return @rv;
763
764 ### this does the same as the above.. just needs a +{ }
765 ### to make sure perl doesn't confuse it for a block
766 return map { my $o=$_;
767 +{ map { $_ => $o->$_() } @$aref }
768 } @{$self->_data};
769 }
770}
771
772sub _find_entry {
773 my $self = shift;
774 my $file = shift;
775
776 unless( defined $file ) {
777 $self->_error( qq[No file specified] );
778 return;
779 }
780
b30bcf62 781 ### it's an object already
782 return $file if UNIVERSAL::isa( $file, 'Archive::Tar::File' );
783
39713df4 784 for my $entry ( @{$self->_data} ) {
785 my $path = $entry->full_path;
786 return $entry if $path eq $file;
787 }
788
789 $self->_error( qq[No such file in archive: '$file'] );
790 return;
791}
792
793=head2 $tar->get_files( [@filenames] )
794
795Returns the C<Archive::Tar::File> objects matching the filenames
796provided. If no filename list was passed, all C<Archive::Tar::File>
797objects in the current Tar object are returned.
798
799Please refer to the C<Archive::Tar::File> documentation on how to
800handle these objects.
801
802=cut
803
804sub get_files {
805 my $self = shift;
806
807 return @{ $self->_data } unless @_;
808
809 my @list;
810 for my $file ( @_ ) {
811 push @list, grep { defined } $self->_find_entry( $file );
812 }
813
814 return @list;
815}
816
817=head2 $tar->get_content( $file )
818
819Return the content of the named file.
820
821=cut
822
823sub get_content {
824 my $self = shift;
825 my $entry = $self->_find_entry( shift ) or return;
826
827 return $entry->data;
828}
829
830=head2 $tar->replace_content( $file, $content )
831
832Make the string $content be the content for the file named $file.
833
834=cut
835
836sub replace_content {
837 my $self = shift;
838 my $entry = $self->_find_entry( shift ) or return;
839
840 return $entry->replace_content( shift );
841}
842
843=head2 $tar->rename( $file, $new_name )
844
845Rename the file of the in-memory archive to $new_name.
846
847Note that you must specify a Unix path for $new_name, since per tar
848standard, all files in the archive must be Unix paths.
849
850Returns true on success and false on failure.
851
852=cut
853
854sub rename {
855 my $self = shift;
856 my $file = shift; return unless defined $file;
857 my $new = shift; return unless defined $new;
858
859 my $entry = $self->_find_entry( $file ) or return;
860
861 return $entry->rename( $new );
862}
863
864=head2 $tar->remove (@filenamelist)
865
866Removes any entries with names matching any of the given filenames
867from the in-memory archive. Returns a list of C<Archive::Tar::File>
868objects that remain.
869
870=cut
871
872sub remove {
873 my $self = shift;
874 my @list = @_;
875
876 my %seen = map { $_->full_path => $_ } @{$self->_data};
877 delete $seen{ $_ } for @list;
878
879 $self->_data( [values %seen] );
880
881 return values %seen;
882}
883
884=head2 $tar->clear
885
886C<clear> clears the current in-memory archive. This effectively gives
887you a 'blank' object, ready to be filled again. Note that C<clear>
888only has effect on the object, not the underlying tarfile.
889
890=cut
891
892sub clear {
893 my $self = shift or return;
894
895 $self->_data( [] );
896 $self->_file( '' );
897
898 return 1;
899}
900
901
902=head2 $tar->write ( [$file, $compressed, $prefix] )
903
904Write the in-memory archive to disk. The first argument can either
905be the name of a file or a reference to an already open filehandle (a
906GLOB reference). If the second argument is true, the module will use
907IO::Zlib to write the file in a compressed format. If IO::Zlib is
908not available, the C<write> method will fail and return.
909
910Note that when you pass in a filehandle, the compression argument
911is ignored, as all files are printed verbatim to your filehandle.
912If you wish to enable compression with filehandles, use an
913C<IO::Zlib> filehandle instead.
914
915Specific levels of compression can be chosen by passing the values 2
916through 9 as the second parameter.
917
918The third argument is an optional prefix. All files will be tucked
919away in the directory you specify as prefix. So if you have files
920'a' and 'b' in your archive, and you specify 'foo' as prefix, they
921will be written to the archive as 'foo/a' and 'foo/b'.
922
923If no arguments are given, C<write> returns the entire formatted
924archive as a string, which could be useful if you'd like to stuff the
925archive into a socket or a pipe to gzip or something.
926
927=cut
928
929sub write {
930 my $self = shift;
931 my $file = shift; $file = '' unless defined $file;
932 my $gzip = shift || 0;
933 my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix;
934 my $dummy = '';
935
936 ### only need a handle if we have a file to print to ###
937 my $handle = length($file)
938 ? ( $self->_get_handle($file, $gzip, WRITE_ONLY->($gzip) )
939 or return )
940 : $HAS_PERLIO ? do { open my $h, '>', \$dummy; $h }
941 : $HAS_IO_STRING ? IO::String->new
942 : __PACKAGE__->no_string_support();
943
944
945
946 for my $entry ( @{$self->_data} ) {
947 ### entries to be written to the tarfile ###
948 my @write_me;
949
950 ### only now will we change the object to reflect the current state
951 ### of the name and prefix fields -- this needs to be limited to
952 ### write() only!
953 my $clone = $entry->clone;
954
955
956 ### so, if you don't want use to use the prefix, we'll stuff
957 ### everything in the name field instead
958 if( $DO_NOT_USE_PREFIX ) {
959
960 ### you might have an extended prefix, if so, set it in the clone
961 ### XXX is ::Unix right?
962 $clone->name( length $ext_prefix
963 ? File::Spec::Unix->catdir( $ext_prefix,
964 $clone->full_path)
965 : $clone->full_path );
966 $clone->prefix( '' );
967
968 ### otherwise, we'll have to set it properly -- prefix part in the
969 ### prefix and name part in the name field.
970 } else {
971
972 ### split them here, not before!
973 my ($prefix,$name) = $clone->_prefix_and_file( $clone->full_path );
974
975 ### you might have an extended prefix, if so, set it in the clone
976 ### XXX is ::Unix right?
977 $prefix = File::Spec::Unix->catdir( $ext_prefix, $prefix )
978 if length $ext_prefix;
979
980 $clone->prefix( $prefix );
981 $clone->name( $name );
982 }
983
984 ### names are too long, and will get truncated if we don't add a
985 ### '@LongLink' file...
986 my $make_longlink = ( length($clone->name) > NAME_LENGTH or
987 length($clone->prefix) > PREFIX_LENGTH
988 ) || 0;
989
990 ### perhaps we need to make a longlink file?
991 if( $make_longlink ) {
992 my $longlink = Archive::Tar::File->new(
993 data => LONGLINK_NAME,
994 $clone->full_path,
995 { type => LONGLINK }
996 );
997
998 unless( $longlink ) {
999 $self->_error( qq[Could not create 'LongLink' entry for ] .
1000 qq[oversize file '] . $clone->full_path ."'" );
1001 return;
1002 };
1003
1004 push @write_me, $longlink;
1005 }
1006
1007 push @write_me, $clone;
1008
1009 ### write the one, optionally 2 a::t::file objects to the handle
1010 for my $clone (@write_me) {
1011
1012 ### if the file is a symlink, there are 2 options:
1013 ### either we leave the symlink intact, but then we don't write any
1014 ### data OR we follow the symlink, which means we actually make a
1015 ### copy. if we do the latter, we have to change the TYPE of the
1016 ### clone to 'FILE'
1017 my $link_ok = $clone->is_symlink && $Archive::Tar::FOLLOW_SYMLINK;
1018 my $data_ok = !$clone->is_symlink && $clone->has_content;
1019
1020 ### downgrade to a 'normal' file if it's a symlink we're going to
1021 ### treat as a regular file
1022 $clone->_downgrade_to_plainfile if $link_ok;
1023
1024 ### get the header for this block
1025 my $header = $self->_format_tar_entry( $clone );
1026 unless( $header ) {
1027 $self->_error(q[Could not format header for: ] .
1028 $clone->full_path );
1029 return;
1030 }
1031
1032 unless( print $handle $header ) {
1033 $self->_error(q[Could not write header for: ] .
1034 $clone->full_path);
1035 return;
1036 }
1037
1038 if( $link_ok or $data_ok ) {
1039 unless( print $handle $clone->data ) {
1040 $self->_error(q[Could not write data for: ] .
1041 $clone->full_path);
1042 return;
1043 }
1044
1045 ### pad the end of the clone if required ###
1046 print $handle TAR_PAD->( $clone->size ) if $clone->size % BLOCK
1047 }
1048
1049 } ### done writing these entries
1050 }
1051
1052 ### write the end markers ###
1053 print $handle TAR_END x 2 or
1054 return $self->_error( qq[Could not write tar end markers] );
b30bcf62 1055
39713df4 1056 ### did you want it written to a file, or returned as a string? ###
b30bcf62 1057 my $rv = length($file) ? 1
39713df4 1058 : $HAS_PERLIO ? $dummy
b30bcf62 1059 : do { seek $handle, 0, 0; local $/; <$handle> };
1060
1061 ### make sure to close the handle;
1062 close $handle;
1063
1064 return $rv;
39713df4 1065}
1066
1067sub _format_tar_entry {
1068 my $self = shift;
1069 my $entry = shift or return;
1070 my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix;
1071 my $no_prefix = shift || 0;
1072
1073 my $file = $entry->name;
1074 my $prefix = $entry->prefix; $prefix = '' unless defined $prefix;
1075
1076 ### remove the prefix from the file name
1077 ### not sure if this is still neeeded --kane
1078 ### no it's not -- Archive::Tar::File->_new_from_file will take care of
1079 ### this for us. Even worse, this would break if we tried to add a file
1080 ### like x/x.
1081 #if( length $prefix ) {
1082 # $file =~ s/^$match//;
1083 #}
1084
1085 $prefix = File::Spec::Unix->catdir($ext_prefix, $prefix)
1086 if length $ext_prefix;
1087
1088 ### not sure why this is... ###
1089 my $l = PREFIX_LENGTH; # is ambiguous otherwise...
1090 substr ($prefix, 0, -$l) = "" if length $prefix >= PREFIX_LENGTH;
1091
1092 my $f1 = "%06o"; my $f2 = "%11o";
1093
1094 ### this might be optimizable with a 'changed' flag in the file objects ###
1095 my $tar = pack (
1096 PACK,
1097 $file,
1098
1099 (map { sprintf( $f1, $entry->$_() ) } qw[mode uid gid]),
1100 (map { sprintf( $f2, $entry->$_() ) } qw[size mtime]),
1101
1102 "", # checksum field - space padded a bit down
1103
1104 (map { $entry->$_() } qw[type linkname magic]),
1105
1106 $entry->version || TAR_VERSION,
1107
1108 (map { $entry->$_() } qw[uname gname]),
1109 (map { sprintf( $f1, $entry->$_() ) } qw[devmajor devminor]),
1110
1111 ($no_prefix ? '' : $prefix)
1112 );
1113
1114 ### add the checksum ###
1115 substr($tar,148,7) = sprintf("%6o\0", unpack("%16C*",$tar));
1116
1117 return $tar;
1118}
1119
1120=head2 $tar->add_files( @filenamelist )
1121
1122Takes a list of filenames and adds them to the in-memory archive.
1123
1124The path to the file is automatically converted to a Unix like
1125equivalent for use in the archive, and, if on MacOS, the file's
1126modification time is converted from the MacOS epoch to the Unix epoch.
1127So tar archives created on MacOS with B<Archive::Tar> can be read
1128both with I<tar> on Unix and applications like I<suntar> or
1129I<Stuffit Expander> on MacOS.
1130
1131Be aware that the file's type/creator and resource fork will be lost,
1132which is usually what you want in cross-platform archives.
1133
1134Returns a list of C<Archive::Tar::File> objects that were just added.
1135
1136=cut
1137
1138sub add_files {
1139 my $self = shift;
1140 my @files = @_ or return;
1141
1142 my @rv;
1143 for my $file ( @files ) {
c3745331 1144 unless( -e $file || -l $file ) {
39713df4 1145 $self->_error( qq[No such file: '$file'] );
1146 next;
1147 }
1148
1149 my $obj = Archive::Tar::File->new( file => $file );
1150 unless( $obj ) {
1151 $self->_error( qq[Unable to add file: '$file'] );
1152 next;
1153 }
1154
1155 push @rv, $obj;
1156 }
1157
1158 push @{$self->{_data}}, @rv;
1159
1160 return @rv;
1161}
1162
1163=head2 $tar->add_data ( $filename, $data, [$opthashref] )
1164
1165Takes a filename, a scalar full of data and optionally a reference to
1166a hash with specific options.
1167
1168Will add a file to the in-memory archive, with name C<$filename> and
1169content C<$data>. Specific properties can be set using C<$opthashref>.
1170The following list of properties is supported: name, size, mtime
1171(last modified date), mode, uid, gid, linkname, uname, gname,
b3200c5d 1172devmajor, devminor, prefix, type. (On MacOS, the file's path and
39713df4 1173modification times are converted to Unix equivalents.)
1174
b3200c5d 1175Valid values for the file type are the following constants defined in
1176Archive::Tar::Constants:
1177
1178=over 4
1179
1180=item FILE
1181
1182Regular file.
1183
1184=item HARDLINK
1185
1186=item SYMLINK
1187
1188Hard and symbolic ("soft") links; linkname should specify target.
1189
1190=item CHARDEV
1191
1192=item BLOCKDEV
1193
1194Character and block devices. devmajor and devminor should specify the major
1195and minor device numbers.
1196
1197=item DIR
1198
1199Directory.
1200
1201=item FIFO
1202
1203FIFO (named pipe).
1204
1205=item SOCKET
1206
1207Socket.
1208
1209=back
1210
39713df4 1211Returns the C<Archive::Tar::File> object that was just added, or
1212C<undef> on failure.
1213
1214=cut
1215
1216sub add_data {
1217 my $self = shift;
1218 my ($file, $data, $opt) = @_;
1219
1220 my $obj = Archive::Tar::File->new( data => $file, $data, $opt );
1221 unless( $obj ) {
1222 $self->_error( qq[Unable to add file: '$file'] );
1223 return;
1224 }
1225
1226 push @{$self->{_data}}, $obj;
1227
1228 return $obj;
1229}
1230
1231=head2 $tar->error( [$BOOL] )
1232
1233Returns the current errorstring (usually, the last error reported).
1234If a true value was specified, it will give the C<Carp::longmess>
1235equivalent of the error, in effect giving you a stacktrace.
1236
1237For backwards compatibility, this error is also available as
1238C<$Archive::Tar::error> although it is much recommended you use the
1239method call instead.
1240
1241=cut
1242
1243{
1244 $error = '';
1245 my $longmess;
1246
1247 sub _error {
1248 my $self = shift;
1249 my $msg = $error = shift;
1250 $longmess = Carp::longmess($error);
1251
1252 ### set Archive::Tar::WARN to 0 to disable printing
1253 ### of errors
1254 if( $WARN ) {
1255 carp $DEBUG ? $longmess : $msg;
1256 }
1257
1258 return;
1259 }
1260
1261 sub error {
1262 my $self = shift;
1263 return shift() ? $longmess : $error;
1264 }
1265}
1266
f38c1908 1267=head2 $tar->setcwd( $cwd );
1268
1269C<Archive::Tar> needs to know the current directory, and it will run
1270C<Cwd::cwd()> I<every> time it extracts a I<relative> entry from the
1271tarfile and saves it in the file system. (As of version 1.30, however,
1272C<Archive::Tar> will use the speed optimization described below
1273automatically, so it's only relevant if you're using C<extract_file()>).
1274
1275Since C<Archive::Tar> doesn't change the current directory internally
1276while it is extracting the items in a tarball, all calls to C<Cwd::cwd()>
1277can be avoided if we can guarantee that the current directory doesn't
1278get changed externally.
1279
1280To use this performance boost, set the current directory via
1281
1282 use Cwd;
1283 $tar->setcwd( cwd() );
1284
1285once before calling a function like C<extract_file> and
1286C<Archive::Tar> will use the current directory setting from then on
1287and won't call C<Cwd::cwd()> internally.
1288
1289To switch back to the default behaviour, use
1290
1291 $tar->setcwd( undef );
1292
1293and C<Archive::Tar> will call C<Cwd::cwd()> internally again.
1294
1295If you're using C<Archive::Tar>'s C<exract()> method, C<setcwd()> will
1296be called for you.
1297
1298=cut
1299
1300sub setcwd {
1301 my $self = shift;
1302 my $cwd = shift;
1303
1304 $self->{cwd} = $cwd;
1305}
39713df4 1306
1307=head2 $bool = $tar->has_io_string
1308
1309Returns true if we currently have C<IO::String> support loaded.
1310
1311Either C<IO::String> or C<perlio> support is needed to support writing
3c4b39be 1312stringified archives. Currently, C<perlio> is the preferred method, if
39713df4 1313available.
1314
1315See the C<GLOBAL VARIABLES> section to see how to change this preference.
1316
1317=cut
1318
1319sub has_io_string { return $HAS_IO_STRING; }
1320
1321=head2 $bool = $tar->has_perlio
1322
1323Returns true if we currently have C<perlio> support loaded.
1324
1325This requires C<perl-5.8> or higher, compiled with C<perlio>
1326
1327Either C<IO::String> or C<perlio> support is needed to support writing
3c4b39be 1328stringified archives. Currently, C<perlio> is the preferred method, if
39713df4 1329available.
1330
1331See the C<GLOBAL VARIABLES> section to see how to change this preference.
1332
1333=cut
1334
1335sub has_perlio { return $HAS_PERLIO; }
1336
1337
1338=head1 Class Methods
1339
1340=head2 Archive::Tar->create_archive($file, $compression, @filelist)
1341
1342Creates a tar file from the list of files provided. The first
1343argument can either be the name of the tar file to create or a
1344reference to an open file handle (e.g. a GLOB reference).
1345
1346The second argument specifies the level of compression to be used, if
1347any. Compression of tar files requires the installation of the
1348IO::Zlib module. Specific levels of compression may be
1349requested by passing a value between 2 and 9 as the second argument.
1350Any other value evaluating as true will result in the default
1351compression level being used.
1352
1353Note that when you pass in a filehandle, the compression argument
1354is ignored, as all files are printed verbatim to your filehandle.
1355If you wish to enable compression with filehandles, use an
1356C<IO::Zlib> filehandle instead.
1357
1358The remaining arguments list the files to be included in the tar file.
1359These files must all exist. Any files which don't exist or can't be
1360read are silently ignored.
1361
1362If the archive creation fails for any reason, C<create_archive> will
1363return false. Please use the C<error> method to find the cause of the
1364failure.
1365
1366Note that this method does not write C<on the fly> as it were; it
1367still reads all the files into memory before writing out the archive.
1368Consult the FAQ below if this is a problem.
1369
1370=cut
1371
1372sub create_archive {
1373 my $class = shift;
1374
1375 my $file = shift; return unless defined $file;
1376 my $gzip = shift || 0;
1377 my @files = @_;
1378
1379 unless( @files ) {
1380 return $class->_error( qq[Cowardly refusing to create empty archive!] );
1381 }
1382
1383 my $tar = $class->new;
1384 $tar->add_files( @files );
1385 return $tar->write( $file, $gzip );
1386}
1387
1388=head2 Archive::Tar->list_archive ($file, $compressed, [\@properties])
1389
1390Returns a list of the names of all the files in the archive. The
1391first argument can either be the name of the tar file to list or a
1392reference to an open file handle (e.g. a GLOB reference).
1393
1394If C<list_archive()> is passed an array reference as its third
1395argument it returns a list of hash references containing the requested
1396properties of each file. The following list of properties is
b3200c5d 1397supported: full_path, name, size, mtime (last modified date), mode,
1398uid, gid, linkname, uname, gname, devmajor, devminor, prefix.
1399
1400See C<Archive::Tar::File> for details about supported properties.
39713df4 1401
1402Passing an array reference containing only one element, 'name', is
1403special cased to return a list of names rather than a list of hash
1404references.
1405
1406=cut
1407
1408sub list_archive {
1409 my $class = shift;
1410 my $file = shift; return unless defined $file;
1411 my $gzip = shift || 0;
1412
1413 my $tar = $class->new($file, $gzip);
1414 return unless $tar;
1415
1416 return $tar->list_files( @_ );
1417}
1418
1419=head2 Archive::Tar->extract_archive ($file, $gzip)
1420
1421Extracts the contents of the tar file. The first argument can either
1422be the name of the tar file to create or a reference to an open file
1423handle (e.g. a GLOB reference). All relative paths in the tar file will
1424be created underneath the current working directory.
1425
1426C<extract_archive> will return a list of files it extracted.
1427If the archive extraction fails for any reason, C<extract_archive>
1428will return false. Please use the C<error> method to find the cause
1429of the failure.
1430
1431=cut
1432
1433sub extract_archive {
1434 my $class = shift;
1435 my $file = shift; return unless defined $file;
1436 my $gzip = shift || 0;
1437
1438 my $tar = $class->new( ) or return;
1439
1440 return $tar->read( $file, $gzip, { extract => 1 } );
1441}
1442
1443=head2 Archive::Tar->can_handle_compressed_files
1444
1445A simple checking routine, which will return true if C<Archive::Tar>
1446is able to uncompress compressed archives on the fly with C<IO::Zlib>,
1447or false if C<IO::Zlib> is not installed.
1448
1449You can use this as a shortcut to determine whether C<Archive::Tar>
1450will do what you think before passing compressed archives to its
1451C<read> method.
1452
1453=cut
1454
1455sub can_handle_compressed_files { return ZLIB ? 1 : 0 }
1456
1457sub no_string_support {
1458 croak("You have to install IO::String to support writing archives to strings");
1459}
1460
14611;
1462
1463__END__
1464
1465=head1 GLOBAL VARIABLES
1466
1467=head2 $Archive::Tar::FOLLOW_SYMLINK
1468
1469Set this variable to C<1> to make C<Archive::Tar> effectively make a
1470copy of the file when extracting. Default is C<0>, which
1471means the symlink stays intact. Of course, you will have to pack the
1472file linked to as well.
1473
1474This option is checked when you write out the tarfile using C<write>
1475or C<create_archive>.
1476
1477This works just like C</bin/tar>'s C<-h> option.
1478
1479=head2 $Archive::Tar::CHOWN
1480
1481By default, C<Archive::Tar> will try to C<chown> your files if it is
1482able to. In some cases, this may not be desired. In that case, set
1483this variable to C<0> to disable C<chown>-ing, even if it were
1484possible.
1485
1486The default is C<1>.
1487
1488=head2 $Archive::Tar::CHMOD
1489
1490By default, C<Archive::Tar> will try to C<chmod> your files to
1491whatever mode was specified for the particular file in the archive.
1492In some cases, this may not be desired. In that case, set this
1493variable to C<0> to disable C<chmod>-ing.
1494
1495The default is C<1>.
1496
1497=head2 $Archive::Tar::DO_NOT_USE_PREFIX
1498
f38c1908 1499By default, C<Archive::Tar> will try to put paths that are over
1500100 characters in the C<prefix> field of your tar header, as
1501defined per POSIX-standard. However, some (older) tar programs
1502do not implement this spec. To retain compatibility with these older
1503or non-POSIX compliant versions, you can set the C<$DO_NOT_USE_PREFIX>
1504variable to a true value, and C<Archive::Tar> will use an alternate
1505way of dealing with paths over 100 characters by using the
1506C<GNU Extended Header> feature.
1507
1508Note that clients who do not support the C<GNU Extended Header>
1509feature will not be able to read these archives. Such clients include
1510tars on C<Solaris>, C<Irix> and C<AIX>.
39713df4 1511
1512The default is C<0>.
1513
1514=head2 $Archive::Tar::DEBUG
1515
1516Set this variable to C<1> to always get the C<Carp::longmess> output
1517of the warnings, instead of the regular C<carp>. This is the same
1518message you would get by doing:
1519
1520 $tar->error(1);
1521
1522Defaults to C<0>.
1523
1524=head2 $Archive::Tar::WARN
1525
1526Set this variable to C<0> if you do not want any warnings printed.
1527Personally I recommend against doing this, but people asked for the
1528option. Also, be advised that this is of course not threadsafe.
1529
1530Defaults to C<1>.
1531
1532=head2 $Archive::Tar::error
1533
1534Holds the last reported error. Kept for historical reasons, but its
1535use is very much discouraged. Use the C<error()> method instead:
1536
1537 warn $tar->error unless $tar->extract;
1538
1539=head2 $Archive::Tar::HAS_PERLIO
1540
1541This variable holds a boolean indicating if we currently have
1542C<perlio> support loaded. This will be enabled for any perl
1543greater than C<5.8> compiled with C<perlio>.
1544
1545If you feel strongly about disabling it, set this variable to
1546C<false>. Note that you will then need C<IO::String> installed
1547to support writing stringified archives.
1548
1549Don't change this variable unless you B<really> know what you're
1550doing.
1551
1552=head2 $Archive::Tar::HAS_IO_STRING
1553
1554This variable holds a boolean indicating if we currently have
1555C<IO::String> support loaded. This will be enabled for any perl
1556that has a loadable C<IO::String> module.
1557
1558If you feel strongly about disabling it, set this variable to
1559C<false>. Note that you will then need C<perlio> support from
1560your perl to be able to write stringified archives.
1561
1562Don't change this variable unless you B<really> know what you're
1563doing.
1564
1565=head1 FAQ
1566
1567=over 4
1568
1569=item What's the minimum perl version required to run Archive::Tar?
1570
1571You will need perl version 5.005_03 or newer.
1572
1573=item Isn't Archive::Tar slow?
1574
1575Yes it is. It's pure perl, so it's a lot slower then your C</bin/tar>
1576However, it's very portable. If speed is an issue, consider using
1577C</bin/tar> instead.
1578
1579=item Isn't Archive::Tar heavier on memory than /bin/tar?
1580
1581Yes it is, see previous answer. Since C<Compress::Zlib> and therefore
1582C<IO::Zlib> doesn't support C<seek> on their filehandles, there is little
1583choice but to read the archive into memory.
1584This is ok if you want to do in-memory manipulation of the archive.
1585If you just want to extract, use the C<extract_archive> class method
1586instead. It will optimize and write to disk immediately.
1587
1588=item Can't you lazy-load data instead?
1589
1590No, not easily. See previous question.
1591
1592=item How much memory will an X kb tar file need?
1593
1594Probably more than X kb, since it will all be read into memory. If
1595this is a problem, and you don't need to do in memory manipulation
1596of the archive, consider using C</bin/tar> instead.
1597
1598=item What do you do with unsupported filetypes in an archive?
1599
1600C<Unix> has a few filetypes that aren't supported on other platforms,
1601like C<Win32>. If we encounter a C<hardlink> or C<symlink> we'll just
1602try to make a copy of the original file, rather than throwing an error.
1603
1604This does require you to read the entire archive in to memory first,
1605since otherwise we wouldn't know what data to fill the copy with.
1606(This means that you cannot use the class methods on archives that
1607have incompatible filetypes and still expect things to work).
1608
1609For other filetypes, like C<chardevs> and C<blockdevs> we'll warn that
1610the extraction of this particular item didn't work.
1611
f38c1908 1612=item I'm using WinZip, or some other non-POSIX client, and files are not being extracted properly!
1613
1614By default, C<Archive::Tar> is in a completely POSIX-compatible
1615mode, which uses the POSIX-specification of C<tar> to store files.
1616For paths greather than 100 characters, this is done using the
1617C<POSIX header prefix>. Non-POSIX-compatible clients may not support
1618this part of the specification, and may only support the C<GNU Extended
1619Header> functionality. To facilitate those clients, you can set the
1620C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. See the
1621C<GLOBAL VARIABLES> section for details on this variable.
1622
c3745331 1623Note that GNU tar earlier than version 1.14 does not cope well with
1624the C<POSIX header prefix>. If you use such a version, consider setting
1625the C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>.
1626
b30bcf62 1627=item How do I extract only files that have property X from an archive?
1628
1629Sometimes, you might not wish to extract a complete archive, just
1630the files that are relevant to you, based on some criteria.
1631
1632You can do this by filtering a list of C<Archive::Tar::File> objects
1633based on your criteria. For example, to extract only files that have
1634the string C<foo> in their title, you would use:
1635
1636 $tar->extract(
1637 grep { $_->full_path =~ /foo/ } $tar->get_files
1638 );
1639
1640This way, you can filter on any attribute of the files in the archive.
1641Consult the C<Archive::Tar::File> documentation on how to use these
1642objects.
1643
81a5970e 1644=item How do I access .tar.Z files?
1645
1646The C<Archive::Tar> module can optionally use C<Compress::Zlib> (via
1647the C<IO::Zlib> module) to access tar files that have been compressed
1648with C<gzip>. Unfortunately tar files compressed with the Unix C<compress>
1649utility cannot be read by C<Compress::Zlib> and so cannot be directly
1650accesses by C<Archive::Tar>.
1651
1652If the C<uncompress> or C<gunzip> programs are available, you can use
1653one of these workarounds to read C<.tar.Z> files from C<Archive::Tar>
1654
1655Firstly with C<uncompress>
1656
1657 use Archive::Tar;
1658
1659 open F, "uncompress -c $filename |";
1660 my $tar = Archive::Tar->new(*F);
1661 ...
1662
1663and this with C<gunzip>
1664
1665 use Archive::Tar;
1666
1667 open F, "gunzip -c $filename |";
1668 my $tar = Archive::Tar->new(*F);
1669 ...
1670
1671Similarly, if the C<compress> program is available, you can use this to
1672write a C<.tar.Z> file
1673
1674 use Archive::Tar;
1675 use IO::File;
1676
1677 my $fh = new IO::File "| compress -c >$filename";
1678 my $tar = Archive::Tar->new();
1679 ...
1680 $tar->write($fh);
1681 $fh->close ;
1682
01d11a1c 1683=item How do I handle Unicode strings?
1684
1685C<Archive::Tar> uses byte semantics for any files it reads from or writes
1686to disk. This is not a problem if you only deal with files and never
1687look at their content or work solely with byte strings. But if you use
1688Unicode strings with character semantics, some additional steps need
1689to be taken.
1690
1691For example, if you add a Unicode string like
1692
1693 # Problem
1694 $tar->add_data('file.txt', "Euro: \x{20AC}");
1695
1696then there will be a problem later when the tarfile gets written out
1697to disk via C<$tar->write()>:
1698
1699 Wide character in print at .../Archive/Tar.pm line 1014.
1700
1701The data was added as a Unicode string and when writing it out to disk,
1702the C<:utf8> line discipline wasn't set by C<Archive::Tar>, so Perl
1703tried to convert the string to ISO-8859 and failed. The written file
1704now contains garbage.
1705
1706For this reason, Unicode strings need to be converted to UTF-8-encoded
1707bytestrings before they are handed off to C<add_data()>:
1708
1709 use Encode;
1710 my $data = "Accented character: \x{20AC}";
1711 $data = encode('utf8', $data);
1712
1713 $tar->add_data('file.txt', $data);
1714
1715A opposite problem occurs if you extract a UTF8-encoded file from a
1716tarball. Using C<get_content()> on the C<Archive::Tar::File> object
1717will return its content as a bytestring, not as a Unicode string.
1718
1719If you want it to be a Unicode string (because you want character
1720semantics with operations like regular expression matching), you need
1721to decode the UTF8-encoded content and have Perl convert it into
1722a Unicode string:
1723
1724 use Encode;
1725 my $data = $tar->get_content();
1726
1727 # Make it a Unicode string
1728 $data = decode('utf8', $data);
1729
1730There is no easy way to provide this functionality in C<Archive::Tar>,
1731because a tarball can contain many files, and each of which could be
1732encoded in a different way.
81a5970e 1733
39713df4 1734=back
1735
1736=head1 TODO
1737
1738=over 4
1739
1740=item Check if passed in handles are open for read/write
1741
1742Currently I don't know of any portable pure perl way to do this.
1743Suggestions welcome.
1744
b3200c5d 1745=item Allow archives to be passed in as string
1746
1747Currently, we only allow opened filehandles or filenames, but
1748not strings. The internals would need some reworking to facilitate
1749stringified archives.
1750
1751=item Facilitate processing an opened filehandle of a compressed archive
1752
1753Currently, we only support this if the filehandle is an IO::Zlib object.
1754Environments, like apache, will present you with an opened filehandle
1755to an uploaded file, which might be a compressed archive.
1756
39713df4 1757=back
1758
f38c1908 1759=head1 SEE ALSO
1760
1761=over 4
1762
1763=item The GNU tar specification
1764
1765C<http://www.gnu.org/software/tar/manual/tar.html>
1766
1767=item The PAX format specication
1768
1769The specifcation which tar derives from; C< http://www.opengroup.org/onlinepubs/007904975/utilities/pax.html>
1770
1771=item A comparison of GNU and POSIX tar standards; C<http://www.delorie.com/gnu/docs/tar/tar_114.html>
1772
1773=item GNU tar intends to switch to POSIX compatibility
1774
1775GNU Tar authors have expressed their intention to become completely
1776POSIX-compatible; C<http://www.gnu.org/software/tar/manual/html_node/Formats.html>
1777
1778=item A Comparison between various tar implementations
1779
1780Lists known issues and incompatibilities; C<http://gd.tuwien.ac.at/utils/archivers/star/README.otherbugs>
1781
1782=back
1783
39713df4 1784=head1 AUTHOR
1785
c3745331 1786This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
1787
1788Please reports bugs to E<lt>bug-archive-tar@rt.cpan.orgE<gt>.
39713df4 1789
1790=head1 ACKNOWLEDGEMENTS
1791
1792Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney and
1793especially Andrew Savige for their help and suggestions.
1794
1795=head1 COPYRIGHT
1796
c3745331 1797This module is copyright (c) 2002 - 2007 Jos Boumans
1798E<lt>kane@cpan.orgE<gt>. All rights reserved.
39713df4 1799
c3745331 1800This library is free software; you may redistribute and/or modify
1801it under the same terms as Perl itself.
39713df4 1802
1803=cut