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