Result:
found 1012 distributions and 1781 files matching your query !
( run in 0.671 )
Sys-RunAlone-User
view release on metacpan or search on metacpan
lib/Sys/RunAlone/User.pm view on Meta::CPAN
1;
sub import {
shift;
my($userName) = (getpwuid($>))[0];
my %args= @_;
$silent = delete $args{silent};
$retry = delete $args{retry};
$retry = $ENV{RETRY_SYS_RUNALONE} if exists $ENV{RETRY_SYS_RUNALONE};
Sys-Statistics-Linux
view release on metacpan or search on metacpan
lib/Sys/Statistics/Linux/Processes.pm view on Meta::CPAN
L<Sys::Statistics::Linux>.
=head1 PROCESS STATISTICS
Generated by F</proc/E<lt>pidE<gt>/stat>, F</proc/E<lt>pidE<gt>/status>,
F</proc/E<lt>pidE<gt>/cmdline> and F<getpwuid()>.
Note that if F</etc/passwd> isn't readable, the key owner is set to F<N/a>.
ppid - The parent process ID of the process.
nlwp - The number of light weight processes that runs by this process.
lib/Sys/Statistics/Linux/Processes.pm view on Meta::CPAN
=head1 SEE ALSO
B<proc(5)>
B<perldoc -f getpwuid>
=head1 REPORTING BUGS
Please report all bugs to <jschulz.cpan(at)bloonix.de>.
lib/Sys/Statistics/Linux/Processes.pm view on Meta::CPAN
open my $fh, '<', "$file->{path}/$pid/$file->{status}"
or return undef;
while (my $line = <$fh>) {
if ($line =~ /^Uid:(?:\s+|\t+)(\d+)/) {
$owner = getpwuid($1) || "N/a";
last;
}
}
close($fh);
Sys-Syslog
view release on metacpan or search on metacpan
sub openlog {
($ident, my $logopt, $facility) = @_;
# default values
$ident ||= basename($0) || getlogin() || getpwuid($<) || 'syslog';
$logopt ||= '';
$facility ||= LOG_USER();
for my $opt (split /\b/, $logopt) {
$options{$opt} = 1 if exists $options{$opt}
Sys-Tlock
view release on metacpan or search on metacpan
lib/Sys/Tlock.pm view on Meta::CPAN
my sub owner_check( $o ) {
return undef if not defined $o;
return [-1,-1] if $o == -1;
my $g = (getpwuid($o))[3];
if (not defined $g) { warn 'Owner "'.$o.'" not found.'; return undef; };
return [$o,$g];
};
Sys-User-UIDhelper
view release on metacpan or search on metacpan
lib/Sys/User/UIDhelper.pm view on Meta::CPAN
use warnings;
use strict;
=head1 NAME
Sys::User::UIDhelper - Helps for locating free UIDs using getpwuid.
=head1 VERSION
Version 0.1.0
lib/Sys/User/UIDhelper.pm view on Meta::CPAN
sub first_free {
my $self = $_[0];
my $int = $self->{min};
while ( $int <= $self->{max} ) {
if ( !getpwuid($int) ) {
return $int;
}
$int++;
}
lib/Sys/User/UIDhelper.pm view on Meta::CPAN
sub last_free {
my $self = $_[0];
my $int = $self->{max};
while ( $int >= $self->{min} ) {
if ( !getpwuid($int) ) {
return $int;
}
$int--;
}
SysV-SharedMem
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
System-InitD
view release on metacpan or search on metacpan
t/02-logic.t view on Meta::CPAN
open DAEMON, '>', $DAEMON_FILE or BAIL_OUT "ERROR $!";;
chmod 0755, $DAEMON_FILE;
print DAEMON $script or BAIL_OUT "ERROR $!";
close DAEMON;
my $user = getpwuid($<);
$user ||= '';
my $options = {
os => 'debian',
target => $INIT_SCRIPT,
TIGR
view release on metacpan or search on metacpan
lib/TIGR/Foundation.pm view on Meta::CPAN
}
# A __WARN__ handler is needed to keep this sane.
my $tmp_warn_handler = $SIG{__WARN__} || "DEFAULT";
$SIG{__WARN__} = sub {};
my @info_arr = getpwuid($<);
$self->{'user_name'} = $info_arr[0];
$self->{'home_dir'} = $info_arr[7];
$SIG{__WARN__} = $tmp_warn_handler;
if ( ! defined ( $self->{'user_name'} ) ) {
$self->{'user_name'} = "NOUSERNAME";
TPath-Forester-File
view release on metacpan or search on metacpan
lib/TPath/Forester/File/Node.pm view on Meta::CPAN
# memoized uid -> user converter
sub _user {
my $self = shift;
state %map;
my $uid = $self->uid;
my $user = $map{$uid} //= getpwuid($uid);
return $user;
}
has group => ( is => 'ro', isa => 'Str', lazy => 1, builder => '_group' );
TT2-Play-Area
view release on metacpan or search on metacpan
lib/auto/TT2/Play/Area/public/codemirror/mode/perl/perl.js view on Meta::CPAN
getprotobyname :1, // - get protocol record given name
getprotobynumber :1, // - get protocol record numeric protocol
getprotoent :1, // - get next protocols record
getpwent :1, // - get next passwd record
getpwnam :1, // - get passwd record given user login name
getpwuid :1, // - get passwd record given user ID
getservbyname :1, // - get services record given its name
getservbyport :1, // - get services record given numeric port
getservent :1, // - get next services record
getsockname :1, // - retrieve the sockaddr for a given socket
getsockopt :1, // - get socket options on a given socket
TableData-Perl-CPAN-Release-Static-2023
view release on metacpan or search on metacpan
share/2023.csv view on Meta::CPAN
"SPVM-Sys-0.508","2023-12-04T01:41:21","KIMOTO","cpan","released","0.508","","SPVM-Sys","System Calls for File IO, Sockets, Time, Process, Signals, Users"
"Error-Helper-2.0.0","2023-12-04T02:43:37","VVELOX","cpan","released","v2.0.0","","Error-Helper","Provides some easy error related methods."
"Export-These-v0.2.1","2023-12-04T06:38:31","DRCLAW","latest","released","v0.2.1","","Export-These","Terse Module Configuration and Symbol (Re)Exporting"
"Mail-SpamAssassin-4.0.1-pre1h-TRIAL","2023-12-04T06:58:51","SIDNEY","backpan","developer","4.000001","","Mail-SpamAssassin","Apache SpamAssassin is an extensible email filter which is used to identify spam"
"IO-FD-v0.3.4","2023-12-04T07:27:55","DRCLAW","cpan","released","v0.3.4","","IO-FD","Faster accept, socket, listen with file descriptors, not handles"
"Sys-User-UIDhelper-0.1.0","2023-12-04T07:28:07","VVELOX","latest","released","v0.1.0","","Sys-User-UIDhelper","Helps for locating free UIDs using getpwuid."
"Net-API-REST-v1.2.0","2023-12-04T07:35:58","JDEGUEST","latest","released","v1.2.0","","Net-API-REST","Implementation of RESTful API"
"App-LXC-Container-0.39","2023-12-04T07:40:18","DORNER","backpan","released","0.39","","App-LXC-Container","configure, create and run LXC application containers"
"Sys-Group-GIDhelper-0.1.0","2023-12-04T08:02:13","VVELOX","latest","released","v0.1.0","","Sys-Group-GIDhelper","Helps for locating free GIDs using getgrgid."
"IO-FD-v0.3.5","2023-12-04T08:13:46","DRCLAW","latest","released","v0.3.5","","IO-FD","Faster accept, socket, listen with file descriptors, not handles"
"Acme-CPANModules-WorkingWithDOC-0.001","2023-12-04T08:32:53","PERLANCAR","latest","released","0.001","1","Acme-CPANModules-WorkingWithDOC","List of modules to work with text document formats (DOC, DOCX, ODT)"
Tapper-Config
view release on metacpan or search on metacpan
lib/auto/Tapper/Config/log4perl.cfg view on Meta::CPAN
log4perl.rootLogger = INFO, root
log4perl.appender.root = Log::Log4perl::Appender::File
log4perl.appender.root.layout = PatternLayout
# date package category - message in last 2 components of filename (linenumber) newline
log4perl.appender.root.layout.ConversionPattern = %d %p %c - %m in %F{2} (%L)%n
log4Perl.appender.root.filename = sub { my $outfile = "/tmp/tapper.debug.".(getpwuid($<) || "unknown").".log"; return $outfile; }
log4Perl.appender.root.mode = append
log4perl.filter.resetter = Log::Log4perl::Filter::StringMatch
log4perl.filter.resetter.StringToMatch = Tapper.MCP.Net.Reset
log4perl.filter.resetter.AcceptOnMatch = false
log4perl.appender.root.Filter = resetter
log4perl.logger.Tapper.Reports.Receiver = DEBUG, ReportsReceiver
log4perl.appender.ReportsReceiver = Log::Log4perl::Appender::File
log4Perl.appender.ReportsReceiver.filename = sub { my $outfile = "/tmp/tapper.reports.receiver.daemon.".(getpwuid($<) || "unknown").".log"; return $outfile; }
log4perl.appender.ReportsReceiver.layout = PatternLayout
log4perl.appender.ReportsReceiver.layout.ConversionPattern = %d %p %c - %m in %F{2} (%L)%n
log4perl.logger.Tapper.MCP.Net.Reset = ALL, MCP
log4perl.appender.MCP = Log::Log4perl::Appender::File
log4Perl.appender.MCP.filename = sub { my $outfile = "/tmp/tapper.mcp.reset_".(getpwuid($<) || "unknown").".log"; return $outfile; }
log4perl.appender.MCP.layout = PatternLayout
log4perl.appender.MCP.layout.ConversionPattern = %d %p %c - %m in %F{2} (%L)%n
log4perl.logger.Tapper.MCP.MessageReceiver = ALL, MessageReceiver
log4perl.appender.MessageReceiver = Log::Log4perl::Appender::File
log4Perl.appender.MessageReceiver.filename = sub { my $outfile = "/tmp/tapper.message.receiver.daemon.".(getpwuid($<) || "unknown").".log"; return $outfile; }
log4perl.appender.MessageReceiver.layout = PatternLayout
log4perl.appender.MessageReceiver.layout.ConversionPattern = %d %p %c - %m in %F{2} (%L)%n
Template-Toolkit
view release on metacpan or search on metacpan
lib/Template/Plugin/File.pm view on Meta::CPAN
|| return $class->throw("$abs: $!");
@$self{ @STAT_KEYS } = @stat;
unless ($config->{ noid }) {
$self->{ user } = eval { getpwuid( $self->{ uid }) || $self->{ uid } };
$self->{ group } = eval { getgrgid( $self->{ gid }) || $self->{ gid } };
}
$self->{ isdir } = -d $abs;
}
lib/Template/Plugin/File.pm view on Meta::CPAN
[% File.mtime %]
[% File.mode %]
...
In addition, the C<user> and C<group> items are set to contain the user
and group names as returned by calls to C<getpwuid()> and C<getgrgid()> for
the file C<uid> and C<gid> elements, respectively. On Win32 platforms
on which C<getpwuid()> and C<getgrid()> are not available, these values are
undefined.
[% USE File('/tmp/foo.html') %]
[% File.uid %] # e.g. 500
[% File.user %] # e.g. abw
Term-Clui
view release on metacpan or search on metacpan
lib/Term/Clui.pm view on Meta::CPAN
print DEBUG "$_[0]\n"; close DEBUG;
}
my (%irow, %icol, $nrows, $clue_has_been_given, $choice, $this_cell);
my @marked;
my $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7];
srand(time() ^ ($$+($$<15)));
sub choose { my $question = shift; local @list = @_; # @list must be local
# As from 1.22, allows multiple choice if called in array context
lib/Term/Clui.pm view on Meta::CPAN
sub logit { my ($file, $msg) = @_;
if (! open(LOG, ">> $rcslog")) { warn "can't open $rcslog: $!\n";
} else {
$pid = fork; # log in background for better response time
if (! $pid) {
($user) = getpwuid($>);
print LOG ×tamp, " $file $user $msg\n"; close LOG;
if ($pid == 0) { exit 0; } # the child's end, if a fork occurred
}
}
}
Term-Menus
view release on metacpan or search on metacpan
lib/Term/Menus.pm view on Meta::CPAN
}
}
my $fa_path=$INC{'Net/FullAuto.pm'};
my $progname=substr($0,(rindex $0,'/')+1,-3);
substr($fa_path,-3)='';
my $username=getlogin || getpwuid($<);
if (-f $fa_path.'/fa_global.pm') {
if (-r $fa_path.'/fa_global.pm') {
{
no strict 'subs';
require $fa_path.'/fa_global.pm';
lib/Term/Menus.pm view on Meta::CPAN
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB ${progname}_sets.db:".
" $BerkeleyDB::Error\n";
}
}
#my $username=getlogin || getpwuid($<);
my $set='';
my $status=$std->db_get(
$username,$set);
$set||='';
$set=~s/\$HASH\d*\s*=\s*//s
lib/Term/Menus.pm view on Meta::CPAN
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB ${progname}_sets.db:".
" $BerkeleyDB::Error\n";
}
}
#my $username=getlogin || getpwuid($<);
my $set='';
my $status=$std->db_get(
$username,$set);
$set||='';
$set=~s/\$HASH\d*\s*=\s*//s
lib/Term/Menus.pm view on Meta::CPAN
$hidedefaults=0;
$start=0;
last;
} elsif ($numbor && unpack('a1',$numbor) eq '!') {
# SHELLOUT shellout
my $username=getlogin || getpwuid($<);
my $cmd=unpack('x1 a*',$numbor);
print "\n";
unless ($^O eq 'cygwin') {
system("su -l -c$cmd $username");
} else {
Term-ReadLine-Gnu
view release on metacpan or search on metacpan
$HOSTNAME $LOGNAME $CWP);
#$PS1 = '$ ';
$PS1='\w[\!]$ ';
$PS2 = '> ';
$HISTFILE = ($ENV{HOME} || ((getpwuid($<))[7])) . "/.perlsh_history";
$HISTSIZE = 256;
$INPUTRC = ($ENV{HOME} || ((getpwuid($<))[7])) . "/.perlshrc";
$STRICT = 0;
$HOSTNAME = $ENV{HOSTNAME};
$LOGNAME = $ENV{LOGNAME};
$CWP = 'main'; # current working package
msgctl msgget msgrcv msgsnd semctl semget
semop shmctl shmget shmread shmwrite
endgrent endhostent endnetent endpwent getgrent
getgrgid getgrnam getlogin getpwent getpwnam
getpwuid setgrent setpwent
endprotoent endservent gethostbyaddr
gethostbyname gethostent getnetbyaddr
getnetbyname getnetent getprotobyname
getprotobynumber getprotoent getservbyname
Term-ReadLine-Perl5
view release on metacpan or search on metacpan
* CHANGES, lib/Term/ReadLine/Perl5.pm,
lib/Term/ReadLine/Perl5/readline.pm: Get ready for release 1.31
2014-05-13 Rocky Bernstein <rocky@cpan.org>
* t/10test-filelist.t: Skip some tests if we don't have getpwuid,
e.g. Strawberry Perl on Windows
2014-05-13 Rocky Bernstein <rocky@cpan.org>
* lib/Term/ReadLine/Perl5/readline-guide.pod,
Term-RouterCLI
view release on metacpan or search on metacpan
lib/Term/RouterCLI/Base.pm view on Meta::CPAN
sub _ExpandTildes
{
my $self = shift;
my $parameter = shift;
$parameter =~ s/^~([^\/]*)/$1?(getpwnam($1))[7]:$ENV{HOME}||$ENV{LOGDIR}||(getpwuid($>))[7]/e;
return $parameter;
}
return 1;
Term-ShellUI
view release on metacpan or search on metacpan
lib/Term/ShellUI.pm view on Meta::CPAN
);
# expand tildes in the history file
if($args{history_file}) {
$args{history_file} =~ s/^~([^\/]*)/$1?(getpwnam($1))[7]:
$ENV{HOME}||$ENV{LOGDIR}||(getpwuid($>))[7]/e;
}
for(keys %args) {
next if $_ eq 'app'; # this param is not a member
$self->{$_} = $args{$_};
Terminal-Identify
view release on metacpan or search on metacpan
lib/Terminal/Identify.pm view on Meta::CPAN
sub get_username {
# Initialise the username.
my $username = "";
# Define the methods for getting the username.
my $method1 = getlogin();
my $method2 = (getpwuid($<))[0];
my $method3 = $ENV{LOGNAME};
my $method4 = $ENV{USER};
# Extract the username.
$username = ($method1 || $method2 || $method3 || $method4);
# Return the username.
Test-AutoBuild
view release on metacpan or search on metacpan
lib/Test/AutoBuild/Stage/EmailAlert.pm view on Meta::CPAN
my $log = Log::Log4perl->get_logger();
my $from = $self->option("from");
unless (defined $from) {
my ($name,$passwd,$uid,$gid,
$quota,$comment,$gcos,$dir,$shell,$expire) = getpwuid($>);
my $email = $name . '@' . hostname;
if ($comment) {
$from = $comment . " <" . $email . ">";
Test-DBIx-Class
view release on metacpan or search on metacpan
getopts ../perl/lib/Getopt/Std.pm /^sub getopts ($;$) {$/;" s class:Std
getproto ../perl/lib/Net/protoent.pm /^sub getproto ($;$) {$/;" s class:protoent
getprotobyname ../perl/lib/Net/protoent.pm /^sub getprotobyname ($) { populate(CORE::getprotobyname(shift)) } $/;" s class:protoent
getprotobynumber ../perl/lib/Net/protoent.pm /^sub getprotobynumber ($) { populate(CORE::getprotobynumber(shift)) } $/;" s class:protoent
getprotoent ../perl/lib/Net/protoent.pm /^sub getprotoent ( ) { populate(CORE::getprotoent()) } $/;" s class:protoent
getpw ../perl/lib/User/pwent.pm /^sub getpw ($) { ($_[0] =~ \/^\\d+\\z\/s) ? &getpwuid : &getpwnam }$/;" s class:pwent
getpwent ../perl/lib/User/pwent.pm /^sub getpwent ( ) { _populate(CORE::getpwent()) }$/;" s class:pwent
getpwnam ../perl/lib/User/pwent.pm /^sub getpwnam ($) { _populate(CORE::getpwnam(shift)) }$/;" s class:pwent
getpwuid ../perl/lib/User/pwent.pm /^sub getpwuid ($) { _populate(CORE::getpwuid(shift)) }$/;" s class:pwent
getserv ../perl/lib/Net/servent.pm /^sub getserv ($;$) {$/;" s class:servent
getservbyname ../perl/lib/Net/servent.pm /^sub getservbyname ($;$) { populate(CORE::getservbyname(shift,shift||'tcp')) }$/;" s class:servent
getservbyport ../perl/lib/Net/servent.pm /^sub getservbyport ($;$) { populate(CORE::getservbyport(shift,shift||'tcp')) }$/;" s class:servent
getservent ../perl/lib/Net/servent.pm /^sub getservent ( ) { populate(CORE::getservent()) }$/;" s class:servent
gid ../perl/lib/File/stat.pm /^ my ($gid, $eff) = @_;$/;" v file: class:stat
pp_gpbyname ../perl/lib/B/Deparse.pm /^sub pp_gpbyname { unop(@_, "getprotobyname") }$/;" s class:Deparse
pp_gpbynumber ../perl/lib/B/Deparse.pm /^sub pp_gpbynumber { listop(@_, "getprotobynumber") }$/;" s class:Deparse
pp_gprotoent ../perl/lib/B/Deparse.pm /^sub pp_gprotoent { baseop(@_, "getprotoent") }$/;" s class:Deparse
pp_gpwent ../perl/lib/B/Deparse.pm /^sub pp_gpwent { baseop(@_, "getpwent") }$/;" s class:Deparse
pp_gpwnam ../perl/lib/B/Deparse.pm /^sub pp_gpwnam { unop(@_, "getpwnam") }$/;" s class:Deparse
pp_gpwuid ../perl/lib/B/Deparse.pm /^sub pp_gpwuid { unop(@_, "getpwuid") }$/;" s class:Deparse
pp_grepstart ../perl/lib/B/Deparse.pm /^sub pp_grepstart { baseop(@_, "grep") }$/;" s class:Deparse
pp_grepwhile ../perl/lib/B/Deparse.pm /^sub pp_grepwhile { mapop(@_, "grep") }$/;" s class:Deparse
pp_gsbyname ../perl/lib/B/Deparse.pm /^sub pp_gsbyname { listop(@_, "getservbyname") }$/;" s class:Deparse
pp_gsbyport ../perl/lib/B/Deparse.pm /^sub pp_gsbyport { listop(@_, "getservbyport") }$/;" s class:Deparse
pp_gservent ../perl/lib/B/Deparse.pm /^sub pp_gservent { baseop(@_, "getservent") }$/;" s class:Deparse
Test-Database
view release on metacpan or search on metacpan
lib/Test/Database/Driver.pm view on Meta::CPAN
# GLOBAL CONFIGURATION
#
# the location where all drivers-related files will be stored
my $KEY = '';
my $login = getlogin() || getpwuid($<);
$login =~ s/\W+//g;
my $root = File::Spec->rel2abs(
File::Spec->catdir( File::Spec->tmpdir(), "Test-Database-$login" ) );
# generic driver class initialisation
Test-FTP-Server
view release on metacpan or search on metacpan
inc/Net/FTP.pm view on Meta::CPAN
my ($ftp, $auth, $resp) = @_;
unless (defined $resp) {
require Net::Netrc;
$auth ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth)
|| Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
($auth, $resp) = $rc->lpa()
Test-File
view release on metacpan or search on metacpan
lib/Test/File.pm view on Meta::CPAN
sub _obviously_non_multi_user {
foreach my $os ( qw(dos MacOS) ) { return 1 if $^O eq $os }
return 0 if $^O eq 'MSWin32';
eval { my $holder = getpwuid(0) };
return 1 if $@;
eval { my $holder = getgrgid(0) };
return 1 if $@;
lib/Test/File.pm view on Meta::CPAN
return;
}
return $Test->ok( 1, $name ) if $file_uid == $owner_uid;
my $real_owner = ( getpwuid $file_uid )[0];
unless( defined $real_owner ) {
$Test->diag("file does not belong to $owner");
return $Test->ok( 0, $name );
}
lib/Test/File.pm view on Meta::CPAN
=item group_is( FILE , GROUP [, NAME ] )
Ok if FILE's group is the same as GROUP. GROUP may be a text group name or
a numeric group id. Test skips on Dos, Mac OS <= 9 and any other operating
systems that do not support getpwuid() and friends. If the file does not
exist, the test fails.
Contributed by Dylan Martin
=cut
lib/Test/File.pm view on Meta::CPAN
=item group_isnt( FILE , GROUP [, NAME ] )
Ok if FILE's group is not the same as GROUP. GROUP may be a text group name or
a numeric group id. Test skips on Dos, Mac OS <= 9 and any other operating
systems that do not support getpwuid() and friends. If the file does not
exist, the test fails.
Contributed by Dylan Martin
=cut
lib/Test/File.pm view on Meta::CPAN
# that doesn't mean that we are done. There might be a name with
# the same value.
#
# Don't use this value in comparisons! An undef could be turned
# into zero!
my $from_uid = (getpwuid($arg))[2] if $arg =~ /\A[0-9]+\z/;
# Now try the argument as a name. If it's a name, then we'll get
# back a UID. Maybe we get back nothing.
my $from_nam = (getpwnam($arg))[2];
return do {
# first case, we got back nothing from getpwnam but did get
# something from getpwuid. The arg is not a name and is a
# UID.
if( defined $from_uid and not defined $from_nam ) { $arg }
# second case, we got back nothing from getpwuid but did get
# something from getpwnam. The arg is a name and is not a
# UID.
elsif( not defined $from_uid and defined $from_nam ) { $from_nam }
# Now, what happens if neither are defined? The argument does
# not correspond to a name or GID on the system. Since no such
lib/Test/File.pm view on Meta::CPAN
# back a GID. Maybe we get back nothing.
my $from_nam = (getgrnam($arg))[2];
return do {
# first case, we got back nothing from getgrnam but did get
# something from getpwuid. The arg is not a name and is a
# GID.
if( defined $from_gid and not defined $from_nam ) { $arg }
# second case, we got back nothing from getgrgid but did get
# something from getgrnam. The arg is a name and is not a
# GID.
Test-Legal
view release on metacpan or search on metacpan
lib/Test/Legal/Util.pm view on Meta::CPAN
=pod
=head2 default_copyright_notice
=cut
sub default_copyright_notice {
my $geco = ucfirst ([getpwuid $<]->[6] || getlogin);
my $year = 1900 + [localtime]->[5];
sprintf '%s %s, %s', '# Copyright (C)', $year, $geco ;
}
=pod
Test-MockFile
view release on metacpan or search on metacpan
lib/Test/MockFile.pm view on Meta::CPAN
# ~
# ~/...
# ~sawyer
if ( $path =~ m{ ^(~ ([^/]+)? ) }xms ) {
my $req_homedir = $1;
my $username = $2 || getpwuid($<);
my $pw_homedir;
# Reset iterator so we *definitely* start from the first one
# Then reset when done looping over pw entries
endpwent;
Test-OpenLDAP
view release on metacpan or search on metacpan
lib/Test/OpenLDAP.pm view on Meta::CPAN
my ($self) = @_;
my $write_flags = Fcntl::O_WRONLY() | Fcntl::O_CREAT() | Fcntl::O_EXCL();
my $uuid = lc $self->_uuid();
my $entry_csn = $self->_entry_csn();
my ( $uid, $gid ) =
( getpwuid $EFFECTIVE_USER_ID )[ UID_INDEX(), GID_INDEX() ];
my $create_timestamp = POSIX::strftime( '%Y%m%d%H%M%SZ', gmtime time );
my $handle = FileHandle->new( $self->{olc_database_config_path},
$write_flags, Fcntl::S_IRUSR() | Fcntl::S_IWUSR() )
or Carp::croak(
"Failed to open '$self-{olc_database_config_path}' for writing:$OS_ERROR"
lib/Test/OpenLDAP.pm view on Meta::CPAN
my $write_flags = Fcntl::O_WRONLY() | Fcntl::O_CREAT() | Fcntl::O_EXCL();
my $uuid = lc $self->_uuid();
my $entry_csn = $self->_entry_csn();
my $create_timestamp = POSIX::strftime( '%Y%m%d%H%M%SZ', gmtime time );
my ( $uid, $gid ) =
( getpwuid $EFFECTIVE_USER_ID )[ UID_INDEX(), GID_INDEX() ];
my $handle = FileHandle->new( $self->{olc_database_path},
$write_flags, Fcntl::S_IRUSR() | Fcntl::S_IWUSR() )
or Carp::croak(
"Failed to open '$self->{olc_database_path}' for writing:$OS_ERROR");
my $user = $self->admin_user();
Test-Perl-Dist
view release on metacpan or search on metacpan
inc/inc_Module-Build/Module/Build/Platform/Unix.pm view on Meta::CPAN
sub _detildefy {
my ($self, $value) = @_;
$value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username
[$1 ?
((getpwnam $1)[7] || "~$1") :
($ENV{HOME} || (getpwuid $>)[7])
]ex;
return $value;
}
1;
( run in 0.671 second using v1.01-cache-2.11-cpan-8d75d55dd25 )