local-lib5/lib/perl5/Archive/Tar/Constant.pm

   1 package Archive::Tar::Constant;
   2
   3 BEGIN {
   4     require Exporter;
   5
   6     $VERSION    = '0.02';
   7     @ISA        = qw[Exporter];
   8
   9     require Time::Local if $^O eq "MacOS";
  10 }
  11
  12 use Package::Constants;
  13 @EXPORT = Package::Constants->list( __PACKAGE__ );
  14
  15 use constant FILE           => 0;
  16 use constant HARDLINK       => 1;
  17 use constant SYMLINK        => 2;
  18 use constant CHARDEV        => 3;
  19 use constant BLOCKDEV       => 4;
  20 use constant DIR            => 5;
  21 use constant FIFO           => 6;
  22 use constant SOCKET         => 8;
  23 use constant UNKNOWN        => 9;
  24 use constant LONGLINK       => 'L';
  25 use constant LABEL          => 'V';
  26
  27 use constant BUFFER         => 4096;
  28 use constant HEAD           => 512;
  29 use constant BLOCK          => 512;
  30
  31 use constant COMPRESS_GZIP  => 9;
  32 use constant COMPRESS_BZIP  => 'bzip2';
  33
  34 use constant BLOCK_SIZE     => sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK };
  35 use constant TAR_PAD        => sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) };
  36 use constant TAR_END        => "\0" x BLOCK;
  37
  38 use constant READ_ONLY      => sub { shift() ? 'rb' : 'r' };
  39 use constant WRITE_ONLY     => sub { $_[0] ? 'wb' . shift : 'w' };
  40 use constant MODE_READ      => sub { $_[0] =~ /^r/ ? 1 : 0 };
  41
  42 # Pointless assignment to make -w shut up
  43 my $getpwuid; $getpwuid = 'unknown' unless eval { my $f = getpwuid (0); };
  44 my $getgrgid; $getgrgid = 'unknown' unless eval { my $f = getgrgid (0); };
  45 use constant UNAME          => sub { $getpwuid || scalar getpwuid( shift() ) || '' };
  46 use constant GNAME          => sub { $getgrgid || scalar getgrgid( shift() ) || '' };
  47 use constant UID            => $>;
  48 use constant GID            => (split ' ', $) )[0];
  49
  50 use constant MODE           => do { 0666 & (0777 & ~umask) };
  51 use constant STRIP_MODE     => sub { shift() & 0777 };
  52 use constant CHECK_SUM      => "      ";
  53
  54 use constant UNPACK         => 'A100 A8 A8 A8 A12 A12 A8 A1 A100 A6 A2 A32 A32 A8 A8 A155 x12';
  55 use constant PACK           => 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
  56 use constant NAME_LENGTH    => 100;
  57 use constant PREFIX_LENGTH  => 155;
  58
  59 use constant TIME_OFFSET    => ($^O eq "MacOS") ? Time::Local::timelocal(0,0,0,1,0,70) : 0;
  60 use constant MAGIC          => "ustar";
  61 use constant TAR_VERSION    => "00";
  62 use constant LONGLINK_NAME  => '././@LongLink';
  63 use constant PAX_HEADER     => 'pax_global_header';
  64
  65                             ### allow ZLIB to be turned off using ENV: DEBUG only
  66 use constant ZLIB           => do { !$ENV{'PERL5_AT_NO_ZLIB'} and
  67                                         eval { require IO::Zlib };
  68                                     $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1
  69                                 };
  70
  71                             ### allow BZIP to be turned off using ENV: DEBUG only
  72 use constant BZIP           => do { !$ENV{'PERL5_AT_NO_BZIP'} and
  73                                         eval { require IO::Uncompress::Bunzip2;
  74                                                require IO::Compress::Bzip2; };
  75                                     $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1
  76                                 };
  77
  78 use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/;
  79 use constant BZIP_MAGIC_NUM => qr/^BZh\d/;
  80
  81 use constant CAN_CHOWN      => sub { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
  82 use constant CAN_READLINK   => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
  83 use constant ON_UNIX        => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS');
  84 use constant ON_VMS         => $^O eq 'VMS';
  85
  86 1;