FunctionalPerl

 view release on metacpan or  search on metacpan

lib/Chj/IO/Tempfile.pm  view on Meta::CPAN

    # keeps uid/gid.
    my $path = $self->xpath;
    my ($uid, $gid, $mode);
    if (($uid, $gid, $mode) = (stat $targetpath)[4, 5, 2]) {
        my $euid = (stat $path)[4];    # better than $> because of peculiarities
        defined $euid
            or croak "xreplace_or_withmode: ?? can't stat own file "
            . Chj::singlequote($path) . ": $!";
        if ($euid == 0) {
            $! = undef;
            chown $uid, $gid, $path
                or croak "xreplace_or_withmode: chown "
                . Chj::singlequote($path) . ": $!";
        } else {
            if ($uid != $euid) {
                carp "xreplace_or_withmode: warning: cannot set owner of "
                    . Chj::singlequote($path)
                    . " to $uid since we are not root"
                    if $warn_all_failures;
                $mode &= 0777;    # see below
            }
            $! = undef;
            chown $euid, $gid, $path or do {

                # only a warning, ok?
                carp "xreplace_or_withmode: warning: could not set group of "
                    . Chj::singlequote($path)
                    . " to $gid: $!"
                    if $warn_all_failures;
                $mode &= 0777;    # mask off setuid and such stuff. correct?
            };
        }

lib/Chj/IO/Tempfile.pm  view on Meta::CPAN

                if $warn_all_failures;
        }
    } else {
        if (defined $orwithmode) {
            if (ref $orwithmode) {

                # assuming stat object
                $mode = $orwithmode->permissions;
                if ($> == 0) {
                    $! = undef;
                    chown $orwithmode->uid, $orwithmode->gid, $path
                        or croak "xreplace_or_withmode: chown "
                        . Chj::singlequote($path) . ": $!";
                }
            } else {
                if ($orwithmode =~ /^0/) {
                    $orwithmode = oct $orwithmode;
                    defined($orwithmode)
                        or croak "xreplace_or_withmode: illegal octal "
                        . "withmode value given";

                    # ^ well, never happens when givint numbers not strings

lib/Chj/xperlfunc.pm  view on Meta::CPAN

    xexec
    xexec_safe
    xsystem
    xxsystem
    xsystem_safe
    xxsystem_safe
    xrename
    xmkdir
    xrmdir
    xchmod
    xchown
    xchdir
    xstat
    xlstat
    Xstat
    Xlstat
    xlocaltime
    xreadlink
    xunlink
    xlink
    xsymlink

lib/Chj/xperlfunc.pm  view on Meta::CPAN

    } else {
        croak "xrmdir: wrong number of arguments";
    }
}

sub xchmod {
    @_ >= 1 or croak "xchmod: not enoug arguments";    # should it be >1?
    chmod shift, @_ or croak "xchmod: $!";
}

sub xchown {
    @_ >= 2 or croak "xchown: not enoug arguments";    # should it be >2?
    chown shift, shift, @_ or croak "xchown: $!";
}

sub xchdir {
    chdir $_[0] or croak "xchdir '$_[0]': $!";
}

our $time_hires = 0;

sub stat_possiblyhires {
    if ($time_hires) {

lib/Chj/xperlfunc.pm  view on Meta::CPAN

        :           croak "xreadlink: wrong number of arguments";
    defined $res or croak @_ ? "xreadlink @_: $!" : "xreadlink: $!";
    $res
}

sub xmkdir_with_paragon {
    @_ == 2 or @_ == 3 or fp_croak_arity "2 or 3";
    warn "UNTESTED!";
    my ($owner, $group, $mode) = (xstat $_[1])[4, 5, 2];
    xmkdir $_[0], 0;
    if (!chown $owner, $group, $_[0]) {
        $_[2] and croak "xmvmkdir: could not recreate user or group: $!";
    }
    xchmod $mode, $_[0];
}

package Chj::xperlfunc::tmpdir {

    sub DESTROY {
        my $self = shift;
        local ($@, $!);

lib/Chj/xperlfunc.pm  view on Meta::CPAN

    my ($owner, $group, $mode) = (xstat $paragon)[4, 5, 2];
    my $newname;
TRY: for (0 .. 2) {
        $newname = $paragon;
        $newname =~ s{(^|/)([^/]+)\z}{"$1.$2.tmp".int(rand(100000))}se;
        last TRY if mkdir $newname, 0;
        if ($! != EEXIST) {
            croak "xtmpdir_with_paragon: mkdir: $!";
        }
    }
    if (!chown $owner, $group, $newname) {
        if ($strict) {
            rmdir $newname;
            croak "xtmpdir_with_paragon: could not recreate user or group: $!";
        }
    }
    if (!chmod $mode, $newname) {
        rmdir $newname;
        croak "xtmpdir_with_paragon: chmod: $!";
    }
    return bless \$newname, 'Chj::xperlfunc::tmpdir';

    # ^ so that it will be removed upon error
}

sub xmvmkdir {
    @_ == 2 or @_ == 3 or fp_croak_arity "2 or 3";
    xrename $_[0], $_[1];
    my ($owner, $group, $mode) = (xstat $_[1])[4, 5, 2];
    xmkdir $_[0], 0;
    if (!chown $owner, $group, $_[0]) {
        $_[2] and croak "xmvmkdir: could not recreate user or group: $!";
    }
    xchmod $mode, $_[0];
}

sub xunlink {
    for (@_) {
        unlink $_ or croak "xunlink '$_': $!";
    }
}

lib/FP/Repl/corefuncs.pm  view on Meta::CPAN

       Input and output functions
           "binmode", "close", "closedir", "dbmclose", "dbmopen", "die", "eof", "fileno",
           "flock", "format", "getc", "print", "printf", "read", "readdir", "rewinddir",
           "seek", "seekdir", "select", "syscall", "sysread", "sysseek", "syswrite",
           "tell", "telldir", "truncate", "warn", "write"

       Functions for fixed length data or records
           "pack", "read", "syscall", "sysread", "syswrite", "unpack", "vec"

       Functions for filehandles, files, or directories
           "-X", "chdir", "chmod", "chown", "chroot", "fcntl", "glob", "ioctl", "link",
           "lstat", "mkdir", "open", "opendir", "readlink", "rename", "rmdir", "stat",
           "symlink", "umask", "unlink", "utime"

       Keywords related to the control flow of your perl program
           "caller", "continue", "die", "do", "dump", "eval", "exit", "goto", "last",
           "next", "redo", "return", "sub", "wantarray"

       Keywords related to scoping
           "caller", "import", "local", "my", "our", "package", "use"