home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _d46813f443318ad44277d7605ef1fd79 < prev    next >
Encoding:
Text File  |  2004-06-01  |  3.0 KB  |  72 lines
  1. package Archive::Tar::Constant;
  2.  
  3. BEGIN {
  4.     require Exporter;
  5.     $VERSION= 0.01;
  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
  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 assigment to make -w shut up
  44. my $getpwuid = 'unknown' unless eval { my $f = getpwuid (0); };
  45. my $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 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.  
  64. use constant ZLIB           => do { eval { require IO::Zlib }; $@ ? 0 : 1 };
  65. use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/;
  66.  
  67. use constant CAN_CHOWN      => do { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
  68. use constant CAN_READLINK   => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
  69. use constant ON_UNIX        => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS');
  70.  
  71. 1;
  72.