view release on metacpan or  search on metacpan

lib/Connector/Builtin/File/Path.pm  view on Meta::CPAN

    my $mode = $self->ifexists();
    if ($mode eq 'fail' && -f $filename) {
        die "File $filename exists";
    }

    if ($mode eq 'silent' && -f $filename) {
        return;
    }

    my $uid = -1;
    my $gid;
    if (my $user = $self->user()) {
        $uid = getpwnam($user) or die "$user not known";
        $gid = -1;
    }

    if (my $group = $self->group()) {
        $gid = getgrnam($group) or die "$group not known";
    }

    if ($mode eq 'append' && -f $filename) {
        open (FILE, ">>",$filename) || die "Unable to open file for appending";
    } else {
        open (FILE, ">", $filename) || die "Unable to open file for writing";
    }

    print FILE $content;
    close FILE;

    if (my $filemode = $self->mode()) {
        if ($filemode =~ m{\A[0-7]{4}\z}) {
            chmod (oct($filemode), $filename) || die "Unable to change mode to $filemode";
        } else {
            die "Given mode string '$filemode' is not valid";
        }
    }

    if ($gid) {
        chown ($uid, $gid, $filename) || die "Unable to chown $filename to $uid/$gid";
    }

    #FIXME - some error handling might not hurt

    return 1;
}


sub _sanitize_path {

t/01-builtin-file-path.t  view on Meta::CPAN

    skip  "skipping chown test - set CONN_PATH_USER in ENV", 1 unless ( $ENV{CONN_PATH_USER} );
    $conn->user($ENV{CONN_PATH_USER} );
    $conn->set('testuser', 'wont see');
    is ($ENV{CONN_PATH_USER}, getpwuid(( stat "t/config/testuser.txt")[4]));
}

SKIP: {
    skip  "skipping chown test - set CONN_PATH_GROUP in ENV", 1 unless ( $ENV{CONN_PATH_GROUP} );
    $conn->group($ENV{CONN_PATH_GROUP} );
    $conn->set('testuser', 'wont see');
    is ($ENV{CONN_PATH_GROUP}, getgrgid(( stat "t/config/testuser.txt")[5]));
}

t/01-proxy-proc-safeexec-uid.t2  view on Meta::CPAN

    #    use_ok( 'Connector::Proxy::Proc::SafeExec' );
    eval 'require Net::Server;';
    our $req_err_ns = $@;
}

package MyTestServer;

if ( not $req_err_ns and not $req_err_ps ) {
    eval 'use base qw( Net::Server::MultiType );'
        or die "Error using Net::Server::MultiType: $@";
    eval 'use Net::Server::Daemonize qw( set_uid set_gid );'
        or die "Error using Net::Server::Daemonize: $@";

    sub new {
        my $that  = shift;
        my $class = ref($that) || $that;
        my $self  = {};
        bless $self, $class;
        # mask isn't available by default, so let's postpone this
        eval '$self->{umask} = mask 0007;';
    }