[Summary view] [Print] [Text view]

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