lib/Archive/Tar.pm

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