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