view release on metacpan or  search on metacpan

lib/File/Valet.pm  view on Meta::CPAN

        ($OK, $ERROR, $ERRNO, $ERRNUM) = ('ERROR', 'no filename supplied', -1, 0);
        return undef;
    }
    $! = 0;
    unless (open($fh, '>> :raw', $fn)) {
        ($OK, $ERROR, $ERRNO, $ERRNUM) = ('ERROR', "cannot open for appending", $!, 0+$!);
        return undef;
    }
    binmode($fh);
    my $res = syswrite($fh, $buf);
    unless (defined $res) {
        ($OK, $ERROR, $ERRNO, $ERRNUM) = ('ERROR', 'write error', $!, 0+$!);
        return undef;
    }
    $res = close($fh);
    unless ($res) {
        ($OK, $ERROR, $ERRNO, $ERRNUM) = ('WARNING', 'close failed', $!, 0+$!);
        return undef;
    }
    ($OK, $ERROR, $ERRNO, $ERRNUM) = ('OK', '', '', 0);
    return 'OK';
}

sub detect_windows {
    return ($^O eq 'MSWin32' || $Config{'osname'} =~ /windows/i || $Config{'osname'} =~ /winserver/i || $Config{'osname'} =~ /microsoft/i) ? 1 : 0;
}

sub find_first {
    foreach my $d (@_) {
        next unless (-e $d);
        ($OK, $ERROR, $ERRNO, $ERRNUM) = ('OK', '', '', 0);
        return $d;
    }
    ($OK, $ERROR, $ERRNO, $ERRNUM) = ('WARNING', 'no file found', '', 0);
    return undef;
}

sub find_home {
    for my $d (@_) {
        return $d if (defined $d && -d $d && -w _);
    }

    my $is_windows = detect_windows;
    ($OK, $ERROR, $ERRNO, $ERRNUM) = ('OK', '', '', 0);

    my $env_home = $ENV{HOME};
    return $env_home if (defined $env_home && -d $env_home);

    my $username = $ENV{USER} // $ENV{USERNAME};
    if ($is_windows) {
        my $home_drive = $ENV{HOMEDRIVE} // 'C:';
        my $home_path  = $ENV{HOMEPATH};
        if (defined $home_path) {
            $env_home = $home_drive . $home_path;
        }
        elsif (defined $username) {
            $env_home = $home_drive . '\\Users\\' . $username;
        }
        return $env_home if (defined $env_home && -d $env_home);
    } else {
        my @row = getpwuid($<);
        if (@row >= 9) {
          my $home_dir = $row[7];
          return $home_dir if (defined $home_dir && -d $home_dir);
        }
        return '/root' if (-d '/root' && -w '/root');
    }

    ($OK, $ERROR, $ERRNO, $ERRNUM) = ('WARNING', 'cannot find home directory', $is_windows, 1);
    return undef;
}

sub find_temp {
    my $is_windows = detect_windows;
    my $dir_sep_tok = '/';
    my $home_dir = find_home;

    push(@_, $ENV{TEMPDIR}) if (defined($ENV{TEMPDIR}));
    push(@_, $ENV{TEMP})    if (defined($ENV{TEMP}));
    push(@_, $ENV{TMP})     if (defined($ENV{TMP}));  # set in Windows sometimes

    if ($is_windows) {
        $dir_sep_tok = '\\';
        push(@_, 'C:\\Windows\\Temp');
        push(@_, 'D:\\Windows\\Temp');
        foreach my $vol (qw(C D E F G W X Y Z)) {
            push(@_, "$vol:\\Temp");
        }
    }
    # might be CygWin, so adding these regardless of OS:
    push(@_, qw (/var/tmp /tmp));

    push(@_, map {join($dir_sep_tok,("$home_dir",$_))} qw(.tmp .temp tmp temp), $home_dir) if (defined($home_dir));
    push(@_, map {join($dir_sep_tok,("$ENV{PWD}", $_))} qw(.tmp .temp tmp temp), $ENV{PWD} ) if (defined($ENV{PWD} ));
    push(@_, '/dev/shm') unless ($is_windows); # Lowest priority, since this is typically a ramdisk.
    foreach my $d (@_) {
        next unless (-d $d);
        ($OK, $ERROR, $ERRNO, $ERRNUM) = ('OK', '', '', 0);
        return $d if (-w _);
    }
    ($OK, $ERROR, $ERRNO, $ERRNUM) = ('WARNING', 'no appropriate temporary directory found', '', 0);
    return undef;
}

sub find_bin {
    return find_bin_win32 (@_) if ($Config::Config{osname} =~ /MSWin/);
    my ($bin_name, @bin_dirs) = @_;
    my $home_dir = find_home;
    push(@bin_dirs, split(/\:/, $ENV{PATH})) if (defined($ENV{PATH}));
    push(@bin_dirs, "$home_dir/bin") if (defined($home_dir));
    push(@bin_dirs, ('/usr/local/sbin', '/usr/local/bin', '/sbin', '/bin', '/usr/sbin', '/usr/bin'));
    my %been_there = ();
    foreach my $d (@bin_dirs) {
        next if (defined($been_there{$d}));
        $been_there{$d} = 1;
        my $f = "$d/$bin_name";
        next unless (-x $f);
        ($OK, $ERROR, $ERRNO, $ERRNUM) = ('OK', '', '', 0);
        return $f;
    }
    ($OK, $ERROR, $ERRNO, $ERRNUM) = ('WARNING', 'no executable found', '', 0);