File Coverage

lib/Archive/Tar/Constant.pm
Criterion Covered Total %
statement 141 141 100.0
branch 16 22 72.7
condition 7 21 33.3
subroutine 41 41 100.0
pod n/a
total 205 225 91.1


line stmt bran cond sub pod time code
1             package Archive::Tar::Constant;
2              
3             BEGIN {
4 11     4   1774     require Exporter;
5 3         28     $VERSION= '0.02';
6 11         1345     @ISA = qw[Exporter];
7 3         72     @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
14             ];
15              
16 3 100       53     require Time::Local if $^O eq "MacOS";
17             }
18              
19 3     4   74 use constant FILE => 0;
  3         56  
  3         122  
20 3     4   48 use constant HARDLINK => 1;
  3         26  
  3         39  
21 3     4   45 use constant SYMLINK => 2;
  3         27  
  3         38  
22 3     4   73 use constant CHARDEV => 3;
  3         27  
  3         38  
23 3     4   44 use constant BLOCKDEV => 4;
  3         28  
  3         37  
24 3     4   43 use constant DIR => 5;
  3         27  
  3         36  
25 3     4   43 use constant FIFO => 6;
  3         56  
  3         38  
26 3     4   47 use constant SOCKET => 8;
  3         27  
  3         39  
27 3     4   43 use constant UNKNOWN => 9;
  3         27  
  3         37  
28 3     4   126 use constant LONGLINK => 'L';
  3         29  
  3         77  
29 3     4   64 use constant LABEL => 'V';
  3         28  
  3         132  
30              
31 3     4   50 use constant BUFFER => 4096;
  3         27  
  3         38  
32 3     4   78 use constant HEAD => 512;
  3         29  
  3         36  
33 3     4   44 use constant BLOCK => 512;
  3         29  
  3         64  
34              
35 3 100   4   45 use constant BLOCK_SIZE => sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK };
  4         41  
  4         51  
  76         825  
  76         816  
  76         2879  
36 4   33 4   61 use constant TAR_PAD => sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) };
  4         38  
  4         55  
  44         595  
  44         1134  
37 4     4   130 use constant TAR_END => "\0" x BLOCK;
  4         43  
  4         56  
38              
39 4 50   4   58 use constant READ_ONLY => sub { shift() ? 'rb' : 'r' };
  4         43  
  4         50  
  31         1162  
40 4 100   4   92 use constant WRITE_ONLY => sub { $_[0] ? 'wb' . shift : 'w' };
  4         38  
  4         85  
  16         624  
41 4 100   4   54 use constant MODE_READ => sub { $_[0] =~ /^r/ ? 1 : 0 };
  4         41  
  4         95  
  31         494  
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 4 50   4   64 use constant UNAME => sub { $getpwuid || scalar getpwuid( shift() ) };
  4         80  
  4         210  
  28         8125  
47 4 50   4   119 use constant GNAME => sub { $getgrgid || scalar getgrgid( shift() ) };
  4         38  
  4         105  
  28         6220  
48 4     4   54 use constant UID => $>;
  4         69  
  4         68  
49 4     4   55 use constant GID => (split ' ', $) )[0];
  4         40  
  4         199  
50              
51 4     4   55 use constant MODE => do { 0666 & (0777 & ~umask) };
  4         40  
  4         44  
  4         99  
52 4     4   62 use constant STRIP_MODE => sub { shift() & 0777 };
  4         253  
  4         78  
  11         139  
53 4     4   73 use constant CHECK_SUM => " ";
  4         38  
  4         53  
54              
55 3     4   46 use constant UNPACK => 'A100 A8 A8 A8 A12 A12 A8 A1 A100 A6 A2 A32 A32 A8 A8 A155 x12';
  3         27  
  3         39  
56 4     4   110 use constant PACK => 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
  4         40  
  4         67  
57 3     4   42 use constant NAME_LENGTH => 100;
  3         91  
  4         56  
58 4     4   73 use constant PREFIX_LENGTH => 155;
  4         62  
  4         53  
59              
60 4 50   4   153 use constant TIME_OFFSET => ($^O eq "MacOS") ? Time::Local::timelocal(0,0,0,1,0,70) : 0;
  4         321  
  3         2013  
61 4     4   113 use constant MAGIC => "ustar";
  4         53  
  4         116  
62 3     4   67 use constant TAR_VERSION => "00";
  4         65  
  4         65  
63 4     4   55 use constant LONGLINK_NAME => '././@LongLink';
  3         28  
  4         354  
64              
65             ### allow ZLIB to be turned off using ENV
66             ### DEBUG only
67 4         119 use constant ZLIB => do { !$ENV{'PERL5_AT_NO_ZLIB'} and
68 4 100       53                                         eval { require IO::Zlib };
  4         414  
69 4 50 33 4   232                                     $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 };
  4         44  
  4         136  
70                                                 
71 4     4   59 use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/;
  4         40  
  4         66  
72              
73 4 50 33 4   65 use constant CAN_CHOWN => do { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
  4         66  
  4         45  
  4         107  
74 4   33 4   57 use constant CAN_READLINK => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
  4   33     88  
  4         97  
75 4   33 4   65 use constant ON_UNIX => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS');
  4   33     90  
  3         154  
76              
77             1;
78