1package Archive::Tar::Constant; 2 3use strict; 4use warnings; 5 6use vars qw[$VERSION @ISA @EXPORT]; 7 8BEGIN { 9 require Exporter; 10 11 $VERSION = '2.40'; 12 @ISA = qw[Exporter]; 13 14 require Time::Local if $^O eq "MacOS"; 15} 16 17@EXPORT = Archive::Tar::Constant->_list_consts( __PACKAGE__ ); 18 19use constant FILE => 0; 20use constant HARDLINK => 1; 21use constant SYMLINK => 2; 22use constant CHARDEV => 3; 23use constant BLOCKDEV => 4; 24use constant DIR => 5; 25use constant FIFO => 6; 26use constant SOCKET => 8; 27use constant UNKNOWN => 9; 28use constant LONGLINK => 'L'; 29use constant LABEL => 'V'; 30 31use constant BUFFER => 4096; 32use constant HEAD => 512; 33use constant BLOCK => 512; 34 35use constant COMPRESS_GZIP => 9; 36use constant COMPRESS_BZIP => 'bzip2'; 37use constant COMPRESS_XZ => 'xz'; 38 39use constant BLOCK_SIZE => sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK }; 40use constant TAR_PAD => sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) }; 41use constant TAR_END => "\0" x BLOCK; 42 43use constant READ_ONLY => sub { shift() ? 'rb' : 'r' }; 44use constant WRITE_ONLY => sub { $_[0] ? 'wb' . shift : 'w' }; 45use constant MODE_READ => sub { $_[0] =~ /^r/ ? 1 : 0 }; 46 47# Pointless assignment to make -w shut up 48my $getpwuid; $getpwuid = 'unknown' unless eval { my $f = getpwuid (0); }; 49my $getgrgid; $getgrgid = 'unknown' unless eval { my $f = getgrgid (0); }; 50use constant UNAME => sub { $getpwuid || scalar getpwuid( shift() ) || '' }; 51use constant GNAME => sub { $getgrgid || scalar getgrgid( shift() ) || '' }; 52use constant UID => $>; 53use constant GID => (split ' ', $) )[0]; 54 55use constant MODE => do { 0666 & (0777 & ~umask) }; 56use constant STRIP_MODE => sub { shift() & 0777 }; 57use constant CHECK_SUM => " "; 58 59use constant UNPACK => 'a100 a8 a8 a8 a12 a12 a8 a1 a100 A6 a2 a32 a32 a8 a8 a155 x12'; # cdrake - size must be a12 - not A12 - or else screws up huge file sizes (>8gb) 60use constant PACK => 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12'; 61use constant NAME_LENGTH => 100; 62use constant PREFIX_LENGTH => 155; 63 64use constant TIME_OFFSET => ($^O eq "MacOS") ? Time::Local::timelocal(0,0,0,1,0,1970) : 0; 65use constant MAGIC => "ustar"; 66use constant TAR_VERSION => "00"; 67use constant LONGLINK_NAME => '././@LongLink'; 68use constant PAX_HEADER => 'pax_global_header'; 69 70 ### allow ZLIB to be turned off using ENV: DEBUG only 71use constant ZLIB => do { !$ENV{'PERL5_AT_NO_ZLIB'} and 72 eval { require IO::Zlib }; 73 $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 74 }; 75 76 ### allow BZIP to be turned off using ENV: DEBUG only 77use constant BZIP => do { !$ENV{'PERL5_AT_NO_BZIP'} and 78 eval { require IO::Uncompress::Bunzip2; 79 require IO::Compress::Bzip2; }; 80 $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1 81 }; 82 83 ### allow XZ to be turned off using ENV: DEBUG only 84use constant XZ => do { !$ENV{'PERL5_AT_NO_XZ'} and 85 eval { require IO::Compress::Xz; 86 require IO::Uncompress::UnXz; }; 87 $ENV{'PERL5_AT_NO_XZ'} || $@ ? 0 : 1 88 }; 89 90use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/; 91 92 # ASCII: B Z h 0 9 93use constant BZIP_MAGIC_NUM => qr/^\x42\x5A\x68[\x30-\x39]/; 94 95use constant XZ_MAGIC_NUM => qr/^\xFD\x37\x7A\x58\x5A\x00/; 96 97use constant CAN_CHOWN => sub { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") }; 98use constant CAN_READLINK => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS'); 99use constant ON_UNIX => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS'); 100use constant ON_VMS => $^O eq 'VMS'; 101 102sub _list_consts { 103 my $class = shift; 104 my $pkg = shift; 105 return unless defined $pkg; # some joker might use '0' as a pkg... 106 107 my @rv; 108 { no strict 'refs'; 109 my $stash = $pkg . '::'; 110 111 for my $name (sort keys %$stash ) { 112 113 ### is it a subentry? 114 my $sub = $pkg->can( $name ); 115 next unless defined $sub; 116 117 next unless defined prototype($sub) and 118 not length prototype($sub); 119 120 push @rv, $name; 121 } 122 } 123 124 return sort @rv; 125} 126 1271; 128