view release on metacpan or  search on metacpan

script/par.pl  view on Meta::CPAN

    require File::Path;

    File::Path::mkpath($path) unless(-e $path); # mkpath dies with error
}

sub require_modules {

    require lib;
    require DynaLoader;
    require integer;
    require strict;
    require warnings;
    require vars;
    require Carp;
    require Carp::Heavy;
    require Errno;
    require Exporter::Heavy;
    require Exporter;
    require Fcntl;
    require File::Temp;
    require File::Spec;
    require XSLoader;
    require Config;
    require IO::Handle;
    require IO::File;
    require Compress::Zlib;
    require Archive::Zip;
    require Digest::SHA;
    require PAR;
    require PAR::Heavy;
    require PAR::Dist;
    require PAR::Filter::PodStrip;
    require PAR::Filter::PatchContent;
    require attributes;
    eval { require Cwd };
    eval { require Win32 };
    eval { require Scalar::Util };
    eval { require Archive::Unzip::Burst };
    eval { require Tie::Hash::NamedCapture };
    eval { require PerlIO; require PerlIO::scalar };
    eval { require utf8 };
}

# The C version of this code appears in myldr/mktmpdir.c
# This code also lives in PAR::SetupTemp as set_par_temp_env!
sub _set_par_temp {
    if (defined $ENV{PAR_TEMP} and $ENV{PAR_TEMP} =~ /(.+)/) {
        $par_temp = $1;
        return;
    }

    foreach my $path (
        (map $ENV{$_}, qw( PAR_TMPDIR TMPDIR TEMPDIR TEMP TMP )),
        qw( C:\\TEMP /tmp . )
    ) {
        next unless defined $path and -d $path and -w $path;
        my $username;
        my $pwuid;
        # does not work everywhere:
        eval {($pwuid) = getpwuid($>) if defined $>;};

        if ( defined(&Win32::LoginName) ) {
            $username = &Win32::LoginName;
        }
        elsif (defined $pwuid) {
            $username = $pwuid;
        }
        else {
            $username = $ENV{USERNAME} || $ENV{USER} || 'SYSTEM';
        }

        my $stmpdir = "$path$sys{_delim}par-".unpack("H*", $username);
        mkdir $stmpdir, 0755;

        my $cache_dir;
        if ($ENV{PAR_CLEAN}) {
            $cache_dir = "temp-$$";
        }
        else {
            open my $fh, "<:raw", $progname or die qq[Can't read "$progname": $!];
            if ((my $magic_pos = find_par_magic($fh)) >= 0) {
                seek $fh, $magic_pos 
                          - $FILE_offset_size 
                          - length("\0CACHE"), 0;
                my $buf;
                read $fh, $buf, length("\0CACHE");
                if ($buf eq "\0CACHE") {
                    seek $fh, $magic_pos 
                              - $FILE_offset_size 
                              - length("\0CACHE") 
                              - $cache_name_size, 0;
                    read $fh, $buf, $cache_name_size;
                    $buf =~ s/\0//g;
                    $cache_dir = "cache-$buf";
                }
            }
            close $fh;
        }
        if (!$cache_dir) {
            $cache_dir = "temp-$$";
            $ENV{PAR_CLEAN} = 1;
        }
        $stmpdir .= "$sys{_delim}$cache_dir";

        mkdir $stmpdir, 0755;
        $ENV{PAR_TEMP} = $stmpdir;
        last;
    }

    $par_temp = $1 if $ENV{PAR_TEMP} and $ENV{PAR_TEMP} =~ /(.+)/;
}


# check if $name (relative to $par_temp) already exists;
# if not, create a file with a unique temporary name,
# fill it with $contents, set its file mode to $mode if present;
# finaly rename it to $name;
# in any case return the absolute filename
sub _save_as {
    my ($name, $contents, $mode) = @_;