<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Archive::Tar::Constant;

BEGIN {
    require Exporter;

    $VERSION    = '2.32';
    @ISA        = qw[Exporter];

    require Time::Local if $^O eq "MacOS";
}

@EXPORT = Archive::Tar::Constant-&gt;_list_consts( __PACKAGE__ );

use strict;
use warnings;

use constant FILE           =&gt; 0;
use constant HARDLINK       =&gt; 1;
use constant SYMLINK        =&gt; 2;
use constant CHARDEV        =&gt; 3;
use constant BLOCKDEV       =&gt; 4;
use constant DIR            =&gt; 5;
use constant FIFO           =&gt; 6;
use constant SOCKET         =&gt; 8;
use constant UNKNOWN        =&gt; 9;
use constant LONGLINK       =&gt; 'L';
use constant LABEL          =&gt; 'V';

use constant BUFFER         =&gt; 4096;
use constant HEAD           =&gt; 512;
use constant BLOCK          =&gt; 512;

use constant COMPRESS_GZIP  =&gt; 9;
use constant COMPRESS_BZIP  =&gt; 'bzip2';

use constant BLOCK_SIZE     =&gt; sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK };
use constant TAR_PAD        =&gt; sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) };
use constant TAR_END        =&gt; "\0" x BLOCK;

use constant READ_ONLY      =&gt; sub { shift() ? 'rb' : 'r' };
use constant WRITE_ONLY     =&gt; sub { $_[0] ? 'wb' . shift : 'w' };
use constant MODE_READ      =&gt; sub { $_[0] =~ /^r/ ? 1 : 0 };

# Pointless assignment to make -w shut up
my $getpwuid; $getpwuid = 'unknown' unless eval { my $f = getpwuid (0); };
my $getgrgid; $getgrgid = 'unknown' unless eval { my $f = getgrgid (0); };
use constant UNAME          =&gt; sub { $getpwuid || scalar getpwuid( shift() ) || '' };
use constant GNAME          =&gt; sub { $getgrgid || scalar getgrgid( shift() ) || '' };
use constant UID            =&gt; $&gt;;
use constant GID            =&gt; (split ' ', $) )[0];

use constant MODE           =&gt; do { 0666 &amp; (0777 &amp; ~umask) };
use constant STRIP_MODE     =&gt; sub { shift() &amp; 0777 };
use constant CHECK_SUM      =&gt; "      ";

use constant UNPACK         =&gt; '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 (&gt;8gb)
use constant PACK           =&gt; 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
use constant NAME_LENGTH    =&gt; 100;
use constant PREFIX_LENGTH  =&gt; 155;

use constant TIME_OFFSET    =&gt; ($^O eq "MacOS") ? Time::Local::timelocal(0,0,0,1,0,70) : 0;
use constant MAGIC          =&gt; "ustar";
use constant TAR_VERSION    =&gt; "00";
use constant LONGLINK_NAME  =&gt; '././@LongLink';
use constant PAX_HEADER     =&gt; 'pax_global_header';

                            ### allow ZLIB to be turned off using ENV: DEBUG only
use constant ZLIB           =&gt; do { !$ENV{'PERL5_AT_NO_ZLIB'} and
                                        eval { require IO::Zlib };
                                    $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1
                                };

                            ### allow BZIP to be turned off using ENV: DEBUG only
use constant BZIP           =&gt; do { !$ENV{'PERL5_AT_NO_BZIP'} and
                                        eval { require IO::Uncompress::Bunzip2;
                                               require IO::Compress::Bzip2; };
                                    $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1
                                };

use constant GZIP_MAGIC_NUM =&gt; qr/^(?:\037\213|\037\235)/;
use constant BZIP_MAGIC_NUM =&gt; qr/^BZh\d/;

use constant CAN_CHOWN      =&gt; sub { ($&gt; == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
use constant CAN_READLINK   =&gt; ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
use constant ON_UNIX        =&gt; ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS');
use constant ON_VMS         =&gt; $^O eq 'VMS';

sub _list_consts {
    my $class = shift;
    my $pkg   = shift;
    return unless defined $pkg; # some joker might use '0' as a pkg...

    my @rv;
    {   no strict 'refs';
        my $stash = $pkg . '::';

        for my $name (sort keys %$stash ) {

            ### is it a subentry?
            my $sub = $pkg-&gt;can( $name );
            next unless defined $sub;

            next unless defined prototype($sub) and
                     not length prototype($sub);

            push @rv, $name;
        }
    }

    return sort @rv;
}

1;
</pre></body></html>