view release on metacpan or search on metacpan
t/50force.t view on Meta::CPAN
$snap = DB2::Admin->GetSnapshot('Subject' => 'SQLMA_APPL_ALL');
ok ($snap, "Application snapshot (before)");
my $agent_id;
my $username = ($^O =~ /^MSWin / ? $ENV{USERNAME} : getpwuid($<));
foreach my $node ($snap->findNodes('APPL')) {
my $dbname = $node->findValue('APPL_INFO/DB_NAME');
$dbname =~ s/\s+$//;
next unless (lc $dbname eq lc $test_db);
view release on metacpan or search on metacpan
t/71_csv-ext.t view on Meta::CPAN
my $dbh;
my @ext = ("", ".csv", ".foo", ".txt");
sub DbFile;
my $usr = eval { getpwuid $< } || $ENV{USERNAME} || "";
sub Tables {
my @tbl = $dbh->tables ();
if ($usr) {
s/^['"]*$usr["']*\.//i for @tbl;
}
view release on metacpan or search on metacpan
$dsql = FALSE;
print ("Running tests in Network mode\n");
$host = hostname ();
$dir = cwd ();
$myuser = getpwuid $<;
system ("rm -rf config");
system ("mkdir config");
$conn_dbname = "SERVER=$host;Database=j_test_db;UID=$myuser;PWD=";
open (ODBC, ">config/srv.conf")
|| die ("open server config file failed");
view release on metacpan or search on metacpan
lib/DBD/Informix/TechSupport.pm view on Meta::CPAN
$| = 1;
# Simulate (Solaris dialect of) 'id' program in Perl.
my ($id, $name, $gid, @rgrps, $egid, @egrps, $pad);
$name = getpwuid($<);
$id = "uid=$<($name)";
@rgrps = split / /, $(;
$gid = $rgrps[0];
shift @rgrps;
$name = getgrgid($gid);
$id .= " gid=$gid($name)";
if ($< != $>)
{
$name = getpwuid($>);
$id .= " euid=$>($name)";
}
@egrps = split / /, $);
$egid = $egrps[0];
if ($egid != $gid)
lib/DBD/Informix/TechSupport.pm view on Meta::CPAN
# Print a report that the installation works
sub it_works
{
my ($sec,$min,$hour,$mday,$mon,$year) = gmtime(time);
my ($date) = sprintf "%04d-%02d-%02d", $year + 1900, $mon + 1, $mday;
my ($uname,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) = getpwuid $>;
#perl -MConfig -e 'for $key (sort keys %Config) { print "$key = $Config{$key}\n"; }'
# Try to generate an email name and address
my ($who) = "$uname\@$Config{myhostname}$Config{mydomain}";
view release on metacpan or search on metacpan
t/dbdpg_test_setup.pl view on Meta::CPAN
## Likely candidates for running this
my @userlist = (qw/postgres postgresql pgsql _postgres/);
## Start with whoever owns this file, unless it's us
my $username = getpwuid ((stat($0))[4]);
unshift @userlist, $username if defined $username and $username ne getpwent;
my %doneuser;
for (@userlist) {
$testuser = $_;
view release on metacpan or search on metacpan
}
if (rc != 0)
return 0;
pwd = getpwuid (statbuff->st_uid);
if (pwd == 0)
return 0;
New (101, dbowner, strlen (pwd->pw_name) + 1, char);
view release on metacpan or search on metacpan
t/dbdpg_test_setup.pl view on Meta::CPAN
## Likely candidates for running this
my @userlist = (qw/postgres postgresql pgsql _postgres/);
## Start with whoever owns this file, unless it's us
my $username = getpwuid ((stat($0))[4]);
unshift @userlist, $username if defined $username and $username ne getpwent;
my %doneuser;
for (@userlist) {
$testuser = $_;
view release on metacpan or search on metacpan
t/dbdpg_test_setup.pl view on Meta::CPAN
## Likely candidates for running this
my @userlist = (qw/postgres postgresql pgsql _postgres/);
## Start with whoever owns this file, unless it's us
my $username = getpwuid ((stat($0))[4]);
unshift @userlist, $username if defined $username and $username ne getpwent;
my %doneuser;
for (@userlist) {
$testuser = $_;
view release on metacpan or search on metacpan
lib/DBD/PgLite.pm view on Meta::CPAN
# http://www.postgresql.org/docs/current/static/functions-misc.html
# Most of these are omitted.
{
name => 'current_user',
argnum => 0,
func => sub { (getpwuid $>)[0] }
},
{
name => 'session_user',
argnum => 0,
func => sub { (getpwuid $>)[0] }
},
{
name => 'user',
argnum => 0,
func => sub { (getpwuid $>)[0] }
},
);
# Transforms a stored procedure into a coderef
view release on metacpan or search on metacpan
lib/DBD/Sys/Plugin/Unix/Lsof.pm view on Meta::CPAN
=head3 uids
Allows restricting the user ids (see lsof(8) for the C<-u> parameter).
$dbh->{sys_openfiles_uids} = [scalar getpwuid $<];
$dbh->{sys_openfiles_uids} = [$<]; # all opened by myself
=head3 pids
Allows restricting the process ids (see lsof(8) for the C<-p> parameter).
view release on metacpan or search on metacpan
lib/DBD/Teradata.pm view on Meta::CPAN
my $rspmsg;
$obj->[19] = 1;
$obj->[20] = $attr->{tdat_lsn} || undef;
my $lgnsrc = $attr->{tdat_logonsrc};
unless ($lgnsrc) {
my $uid = getlogin || getpwuid $< || '????';
$dbsys .= ' ' x (12 - length($dbsys))
if (length($dbsys) < 12);
my $app = $0;
$app = substr($app, 0, 20)
if (length($app) > 20);
view release on metacpan or search on metacpan
GETPWENT_R_PROTO|5.008000|5.008000|Vn
getpwnam|5.009000||Viu
GETPWNAM_R_HAS_BUFFER|5.008000||Viu
GETPWNAM_R_HAS_PTR|5.008000||Viu
GETPWNAM_R_PROTO|5.008000|5.008000|Vn
getpwuid|5.009000||Viu
GETPWUID_R_HAS_PTR|5.008000||Viu
GETPWUID_R_PROTO|5.008000|5.008000|Vn
get_quantifier_value|5.033006||Viu
get_re_arg|||xciu
get_re_gclass_nonbitmap_data|5.031011||Viu
KEY_getprotobyname|5.003007||Viu
KEY_getprotobynumber|5.003007||Viu
KEY_getprotoent|5.003007||Viu
KEY_getpwent|5.003007||Viu
KEY_getpwnam|5.003007||Viu
KEY_getpwuid|5.003007||Viu
KEY_getservbyname|5.003007||Viu
KEY_getservbyport|5.003007||Viu
KEY_getservent|5.003007||Viu
KEY_getsockname|5.003007||Viu
KEY_getsockopt|5.003007||Viu
view release on metacpan or search on metacpan
SimpleMySQL.pm view on Meta::CPAN
sub dbconnect ($) {
my $dbinfo = shift;
${$dbinfo}{host} = 'localhost' unless(defined(${$dbinfo}{host}));
${$dbinfo}{user} = scalar(getpwuid($<)) unless(defined(${$dbinfo}{user}));
${$dbinfo}{pass} = '' unless(defined(${$dbinfo}{pass}));
${$dbinfo}{port} = '3306' unless(defined(${$dbinfo}{port}));
${$dbinfo}{RaiseError} = 0 unless(defined(${$dbinfo}{RaiseError}));
${$dbinfo}{AutoCommit} = 1 unless(defined(${$dbinfo}{AutoCommit}));
view release on metacpan or search on metacpan
lib/DBI/Log.pm view on Meta::CPAN
$opts{fh} = \*STDERR;
}
else {
my $file2 = $opts{file};
if ($file2 =~ m{^~/}) {
my $home = $ENV{HOME} || (getpwuid($<))[7];
$file2 =~ s{^~/}{$home/};
}
open $opts{fh}, ">>", $file2 or die "Can't open $opts{file}: $!\n";
# autoflush so that tailing to watch queries being performed works
# as you'd expect
view release on metacpan or search on metacpan
lib/DBD/File.pm view on Meta::CPAN
$class =~ s/::db$/::Table/;
my ($file, %names);
my $schema = exists $dbh->{f_schema}
? defined $dbh->{f_schema} && $dbh->{f_schema} ne ""
? $dbh->{f_schema} : undef
: eval { getpwuid ((stat $dir)[4]) }; # XXX Win32::pwent
while (defined ($file = $dirh->read ())) {
my ($tbl, $meta) = $class->get_table_meta ($dbh, $file, 0, 0) or next; # XXX
# $tbl && $meta && -f $meta->{f_fqfn} or next;
$seen{defined $schema ? $schema : "\0"}{$dir}{$tbl}++ or
push @tables, [ undef, $schema, $tbl, "TABLE", "FILE" ];
view release on metacpan or search on metacpan
lib/App/DBICx/Backend/Move.pm view on Meta::CPAN
use warnings;
use base qw(App::Cmd::Simple);
use DBI;
use Module::Load 'load';
my $user = getlogin || getpwuid($<) || "unknown";
sub opt_spec {
return (
[ "schema|s=s", "Name of the database schema", { required => 1 } ],
[ "from_dsn|f=s", "DSN for source database", { required => 1 } ],
view release on metacpan or search on metacpan
lib/DBIx/Connector/Pool.pm view on Meta::CPAN
$args{initial} //= 1;
$args{tid_func} //= sub {1};
$args{wait_func} //= sub {croak "real waiting function must be supplied"};
$args{max_size} ||= -1;
$args{keep_alive} //= -1;
$args{user} //= ((getpwuid $>)[0]);
$args{password} //= '';
$args{attrs} //= {};
$args{dsn} //= 'dbi:Pg:dbname=' . $args{user};
$args{connector_mode} //= 'fixup';
if ($args{max_size} > 0 && $args{initial} != 0 && $args{initial} > $args{max_size}) {
view release on metacpan or search on metacpan
# we may try to get password from DBMS specific
# configuration file
unless (defined $self->{PASS}) {
unless (defined $self->{'USER'}
&& $self->{'USER'} ne getpwuid($<)) {
$self->passwd();
}
}
return ($self);
# determine home directory
if (exists $ENV{'HOME'} && $ENV{'HOME'} =~ /\S/ && -d $ENV{'HOME'}) {
$mycnf = $ENV{'HOME'};
} else {
$mycnf = (getpwuid($>)) [7];
}
$mycnf .= '/.my.cnf';
# just give up if file is not accessible
open (CNF, $mycnf) || return;
view release on metacpan or search on metacpan
$test_opts{Pg} =
$build->y_n("Do you want to run the PostgreSQL tests? (y/n)", "n");
}
if($test_opts{Pg}) {
my $user = scalar getpwuid($<);
$test_opts{Pg_host} = $build->prompt(
" Postgres server hostname (leave blank to use local socket):"
);
if($test_opts{Pg_host}) {
"Do you want to run the MySQL tests? (y/n)", "n"
);
}
if($test_opts{mysql}) {
my $user = scalar getpwuid($<);
$test_opts{mysql_host} = $build->prompt(
" MySQL server hostname (leave blank to use local socket):"
);
if($test_opts{mysql_host}) {
$test_opts{mysql_port} = $build->prompt(
view release on metacpan or search on metacpan
if ($^O =~ /Win32/) {
$testdsn .= ';host=localhost';
} else {
$testdsn .= ";host=$testdir/data/socket";
}
$testuser = ((getpwuid $>)[0]);
die "not connected $testdsn/$testuser: " . DBI::errstr()
unless DBI->connect($testdsn, $testuser, '', {RaiseError => 0, PrintError => 0, AutoCommit => 1});
1;
}
view release on metacpan or search on metacpan
lib/DBIx/SimpleQuery.pm view on Meta::CPAN
my @available_drivers = DBI->available_drivers();
@available_drivers = grep { /^(?:Oracle|Pg|mysql)$/ } @available_drivers;
my @data_sources = DBI->data_sources(shift @available_drivers);
$self->{"dsn"} = shift(@data_sources);
$self->{"user"} = getpwuid($>);
$self->{"password"} = "";
}
return bless $self, $class;
}
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
print "Please supply a DBI database source name (DSN) to connect with for the unit tests.\n";
print "Note that if your database is not fully transactional (such as older versions of MySQL ",
"these tests may fail.\n";
print "If this left blank, unit tests which depend on having a live database will be skipped.\n";
my $u = scalar getpwuid($<);
$test_opts{dsn} = prompt(qq{What DSN should we use for our unit tests? (eg; "DBI:Pg:dbname=$u")\n [$test_opts{dsn}]}, $test_opts{dsn});
if($test_opts{dsn} && $test_opts{dsn} !~ /^DBI:SQLITE2:/i) {
$test_opts{dsn_user} = prompt(" Username to connect to the database with:");
$test_opts{dsn_pass} = prompt(" Password to connect to the database with:");
view release on metacpan or search on metacpan
GETPWENT_R_PROTO|5.008000|5.008000|Vn
getpwnam|5.009000||Viu
GETPWNAM_R_HAS_BUFFER|5.008000||Viu
GETPWNAM_R_HAS_PTR|5.008000||Viu
GETPWNAM_R_PROTO|5.008000|5.008000|Vn
getpwuid|5.009000||Viu
GETPWUID_R_HAS_PTR|5.008000||Viu
GETPWUID_R_PROTO|5.008000|5.008000|Vn
get_quantifier_value|5.033006||Viu
get_re_arg|||xciu
get_re_gclass_nonbitmap_data|5.031011||Viu
KEY_getprotobyname|5.003007||Viu
KEY_getprotobynumber|5.003007||Viu
KEY_getprotoent|5.003007||Viu
KEY_getpwent|5.003007||Viu
KEY_getpwnam|5.003007||Viu
KEY_getpwuid|5.003007||Viu
KEY_getservbyname|5.003007||Viu
KEY_getservbyport|5.003007||Viu
KEY_getservent|5.003007||Viu
KEY_getsockname|5.003007||Viu
KEY_getsockopt|5.003007||Viu
view release on metacpan or search on metacpan
t/login/login.t view on Meta::CPAN
use DCE::test;
use DCE::Login;
($pname, $password) = ("cell_admin", "");
$pname ||= (getpwuid($<))[0];
$password ||= $ENV{DCE_PERL_TEST_PW};
unless ($password) {
warn "Skipping tests: no password to certify identity";
print "1..1\nok 1\n";
view release on metacpan or search on metacpan
# heading => 0,
# prompt => 0,
);
my $user = getlogin
|| scalar getpwuid($REAL_USER_ID)
|| undef;
print STDERR "Enter Action [CREATE]: ";
chomp( my $action = <STDIN> );
$action = "create" unless $action;
view release on metacpan or search on metacpan
easyxs/ppport.h view on Meta::CPAN
GETPWENT_R_PROTO|5.008000|5.008000|Vn
getpwnam|5.009000||Viu
GETPWNAM_R_HAS_BUFFER|5.008000||Viu
GETPWNAM_R_HAS_PTR|5.008000||Viu
GETPWNAM_R_PROTO|5.008000|5.008000|Vn
getpwuid|5.009000||Viu
GETPWUID_R_HAS_PTR|5.008000||Viu
GETPWUID_R_PROTO|5.008000|5.008000|Vn
get_quantifier_value|5.033006||Viu
get_re_arg|||xciu
get_re_gclass_nonbitmap_data|5.031011||Viu
easyxs/ppport.h view on Meta::CPAN
KEY_getprotobyname|5.003007||Viu
KEY_getprotobynumber|5.003007||Viu
KEY_getprotoent|5.003007||Viu
KEY_getpwent|5.003007||Viu
KEY_getpwnam|5.003007||Viu
KEY_getpwuid|5.003007||Viu
KEY_getservbyname|5.003007||Viu
KEY_getservbyport|5.003007||Viu
KEY_getservent|5.003007||Viu
KEY_getsockname|5.003007||Viu
KEY_getsockopt|5.003007||Viu
view release on metacpan or search on metacpan
CAB/Server/HTTP/UNIX.pm view on Meta::CPAN
? $srv->{socketGroup}
: getgrnam($srv->{socketGroup}//''));
if (defined($sockuid) || defined($sockgid)) {
$sockuid //= $>;
$sockgid //= $);
$srv->vlog('info', "setting socket ownership (".scalar(getpwuid $sockuid).".".scalar(getgrgid $sockgid).") on $sockpath");
chown($sockuid, $sockgid, $sockpath)
or $srv->logconfess("prepareLocal(): failed to set ownership for socket '$sockpath': $!");
foreach my $dir (reverse @{$srv->{_socketDirs}||[]}) {
$srv->vlog('info', "setting directory ownership (".scalar(getpwuid $sockuid).".".scalar(getgrgid $sockgid).") on $dir");
chown($sockuid, $sockgid, $dir)
or $srv->logconfess("prepareLocal(): failed to set ownership for directory '$dir': $!");
}
}
CAB/Server/HTTP/UNIX.pm view on Meta::CPAN
## + returns stringified unix peer credentials: "${USER}.${GROUP}[${PID}]"
sub peerstr {
my ($sock,$pid,$uid,$gid) = @_;
($pid,$uid,$gid) = $sock->peercred() if (@_ < 4);
return (
(defined($uid) ? (getpwuid($uid)//'?') : '?')
.'.'
.(defined($gid) ? (getgrgid($gid)//'?') : '?')
.':'
.(defined($pid) ? (basename(pid_cmd($pid)//'?')."[$pid]") : '?[?]')
);
view release on metacpan or search on metacpan
lib/Daemon/Control.pm view on Meta::CPAN
sub _set_gid_from_name {
my ( $self ) = @_;
# Grab the GID if we have a UID but no GID.
if ( !defined $self->group && defined $self->uid ) {
my ( $gid ) = ( (getpwuid( $self->uid ))[3] );
$self->gid( $gid );
$self->trace( "Implicit GID => $gid" );
return $gid;
}
lib/Daemon/Control.pm view on Meta::CPAN
}
if ( $self->uid ) {
setuid( $self->uid );
$ENV{USER} = $self->user || getpwuid($self->uid);
$ENV{HOME} = ((getpwuid($self->uid))[7]);
$self->trace( "setuid(" . $self->uid . ")" );
$self->trace( "\$ENV{USER} => " . $ENV{USER} );
$self->trace( "\$ENV{HOME} => " . $ENV{HOME} );
}
view release on metacpan or search on metacpan
lib/Daemon/Device.pm view on Meta::CPAN
on_message
data
) );
if ( not $self->{_daemon}{user} ) {
my $user = getlogin || getpwuid($<) || 'root';
$self->{_daemon}{user} ||= $user;
}
$self->{_daemon}{group} ||= ( getgrgid( (getpwnam( $self->{_daemon}{user} ) )[3] ) )[0];
croak 'new() called without "daemon" parameter as a hashref' unless ( ref( $self->{_daemon} ) eq 'HASH' );
view release on metacpan or search on metacpan
lib/Dancer2/Plugin/WebService.pm view on Meta::CPAN
# If the Authorization method is an external script
if ($plg->auth_method ne 'INTERNAL') {
unless (exists $method->{Command}) {warn "The active Authentication method \"".$plg->auth_method."\" does not know what to do\n"; exit 1}
$method->{Command} =~s/^MODULE_INSTALL_DIR/$module_dir/;
unless (-f $method->{Command}) {warn "Sorry, could not found the external authorization utility $method->{Command}\n"; exit 1}
unless (-x $method->{Command}) {warn "Sorry, the external authorization utility $method->{Command} is not executable from user ". getpwuid($>) ."\n"; exit 1}
if ((exists $method->{'Use sudo'}) && ($method->{'Use sudo'}=~/(?i)[y1t]/)) {
my $sudo = undef;
foreach (qw[/usr/bin /bin /usr/sbin /sbin]) { if ((-f "$_/sudo") && -x ("$_/sudo")) { $sudo="$_/sudo"; last } }
unless (defined $sudo) {warn "Could not found sudo command\n"; exit 1}
lib/Dancer2/Plugin/WebService.pm view on Meta::CPAN
}
print STDOUT "\n";
print STDOUT "Application name : ", $plg->dsl->config->{appname} ,"\n";
print STDOUT 'Start time : ', scalar localtime $^T ,"\n";
print STDOUT 'Run as user : ', (getpwuid($>))[0] ,"\n";
print STDOUT "Command : $0\n";
print STDOUT "PID parent : ", getppid() ,"\n";
print STDOUT "PID Main : $$\n";
print STDOUT 'Authorization method : ', ( $plg->auth_method ? $plg->auth_method :'UNDEFINED' ) ,"\n";
print STDOUT "Authorization scripts : $module_dir/\n";