perl
view release on metacpan or search on metacpan
getprotobynumber_r_proto=''
d_getprotoent_r=''
getprotoent_r_proto=''
d_getprotoprotos=''
d_getprpwnam=''
d_getpwent=''
d_getpwent_r=''
getpwent_r_proto=''
d_getpwnam_r=''
getpwnam_r_proto=''
d_getpwuid_r=''
getpwuid_r_proto=''
d_getsent=''
d_getservbyname_r=''
getservbyname_r_proto=''
d_getservbyport_r=''
getservbyport_r_proto=''
d_getservent_r=''
getservent_r_proto=''
d_getservprotos=''
d_getspnam=''
d_getspnam_r=''
esac
d_getpwnam_r=undef
getpwnam_r_proto=0
;;
esac
;;
*) getpwnam_r_proto=0
;;
esac
: see if getpwuid_r exists
set getpwuid_r d_getpwuid_r
eval $inlibc
case "$d_getpwuid_r" in
"$define")
hdrs="$i_systypes sys/types.h define stdio.h $i_pwd pwd.h"
case "$d_getpwuid_r_proto:$usethreads" in
":define") d_getpwuid_r_proto=define
set d_getpwuid_r_proto getpwuid_r $hdrs
eval $hasproto ;;
*) ;;
esac
case "$d_getpwuid_r_proto" in
define)
case "$getpwuid_r_proto" in
''|0) try='int getpwuid_r(uid_t, struct passwd*, char*, size_t, struct passwd**);'
./protochk "$extern_C $try" $hdrs && getpwuid_r_proto=I_TSBWR ;;
esac
case "$getpwuid_r_proto" in
''|0) try='int getpwuid_r(uid_t, struct passwd*, char*, int, struct passwd**);'
./protochk "$extern_C $try" $hdrs && getpwuid_r_proto=I_TSBIR ;;
esac
case "$getpwuid_r_proto" in
''|0) try='int getpwuid_r(uid_t, struct passwd*, char*, int);'
./protochk "$extern_C $try" $hdrs && getpwuid_r_proto=I_TSBI ;;
esac
case "$getpwuid_r_proto" in
''|0) try='struct passwd* getpwuid_r(uid_t, struct passwd*, char*, int);'
./protochk "$extern_C $try" $hdrs && getpwuid_r_proto=S_TSBI ;;
esac
case "$getpwuid_r_proto" in
''|0) d_getpwuid_r=undef
getpwuid_r_proto=0
echo "Disabling getpwuid_r, cannot determine prototype." >&4 ;;
* ) case "$getpwuid_r_proto" in
REENTRANT_PROTO*) ;;
*) getpwuid_r_proto="REENTRANT_PROTO_$getpwuid_r_proto" ;;
esac
echo "Prototype: $try" ;;
esac
;;
*) case "$usethreads" in
define) echo "getpwuid_r has no prototype, not using it." >&4 ;;
esac
d_getpwuid_r=undef
getpwuid_r_proto=0
;;
esac
;;
*) getpwuid_r_proto=0
;;
esac
: Optional checks for getsbyname and getsbyport
: see if getservbyname exists
set getservbyname d_getsbyname
eval $inlibc
: see if getservbyport exists
d_getppid='$d_getppid'
d_getprior='$d_getprior'
d_getprotobyname_r='$d_getprotobyname_r'
d_getprotobynumber_r='$d_getprotobynumber_r'
d_getprotoent_r='$d_getprotoent_r'
d_getprotoprotos='$d_getprotoprotos'
d_getprpwnam='$d_getprpwnam'
d_getpwent='$d_getpwent'
d_getpwent_r='$d_getpwent_r'
d_getpwnam_r='$d_getpwnam_r'
d_getpwuid_r='$d_getpwuid_r'
d_getsbyname='$d_getsbyname'
d_getsbyport='$d_getsbyport'
d_getsent='$d_getsent'
d_getservbyname_r='$d_getservbyname_r'
d_getservbyport_r='$d_getservbyport_r'
d_getservent_r='$d_getservent_r'
d_getservprotos='$d_getservprotos'
d_getspnam='$d_getspnam'
d_getspnam_r='$d_getspnam_r'
d_gettimeod='$d_gettimeod'
gethostent_r_proto='$gethostent_r_proto'
getlogin_r_proto='$getlogin_r_proto'
getnetbyaddr_r_proto='$getnetbyaddr_r_proto'
getnetbyname_r_proto='$getnetbyname_r_proto'
getnetent_r_proto='$getnetent_r_proto'
getprotobyname_r_proto='$getprotobyname_r_proto'
getprotobynumber_r_proto='$getprotobynumber_r_proto'
getprotoent_r_proto='$getprotoent_r_proto'
getpwent_r_proto='$getpwent_r_proto'
getpwnam_r_proto='$getpwnam_r_proto'
getpwuid_r_proto='$getpwuid_r_proto'
getservbyname_r_proto='$getservbyname_r_proto'
getservbyport_r_proto='$getservbyport_r_proto'
getservent_r_proto='$getservent_r_proto'
getspnam_r_proto='$getspnam_r_proto'
gidformat='$gidformat'
gidsign='$gidsign'
gidsize='$gidsize'
gidtype='$gidtype'
glibpth='$glibpth'
gmake='$gmake'
Cross/config.sh-arm-linux view on Meta::CPAN
d_getppid='define'
d_getprior='define'
d_getprotobyname_r='undef'
d_getprotobynumber_r='undef'
d_getprotoent_r='undef'
d_getprotoprotos='define'
d_getprpwnam='undef'
d_getpwent='define'
d_getpwent_r='undef'
d_getpwnam_r='undef'
d_getpwuid_r='undef'
d_getsbyname='define'
d_getsbyport='define'
d_getsent='define'
d_getservbyname_r='undef'
d_getservbyport_r='undef'
d_getservent_r='undef'
d_getservprotos='define'
d_getspnam='define'
d_getspnam_r='undef'
d_gettimeod='define'
Cross/config.sh-arm-linux view on Meta::CPAN
gethostent_r_proto='0'
getlogin_r_proto='0'
getnetbyaddr_r_proto='0'
getnetbyname_r_proto='0'
getnetent_r_proto='0'
getprotobyname_r_proto='0'
getprotobynumber_r_proto='0'
getprotoent_r_proto='0'
getpwent_r_proto='0'
getpwnam_r_proto='0'
getpwuid_r_proto='0'
getservbyname_r_proto='0'
getservbyport_r_proto='0'
getservent_r_proto='0'
getspnam_r_proto='0'
gidformat='"lu"'
gidsign='1'
gidsize='4'
gidtype='gid_t'
glibpth='/usr/shlib /lib /usr/lib /usr/lib/386 /lib/386 /usr/ccs/lib /usr/ucblib /usr/local/lib '
gmake='gmake'
Cross/config.sh-arm-linux-n770 view on Meta::CPAN
d_getppid='define'
d_getprior='define'
d_getprotobyname_r='undef'
d_getprotobynumber_r='undef'
d_getprotoent_r='undef'
d_getprotoprotos='define'
d_getprpwnam='undef'
d_getpwent='define'
d_getpwent_r='undef'
d_getpwnam_r='undef'
d_getpwuid_r='undef'
d_getsbyname='define'
d_getsbyport='define'
d_getsent='define'
d_getservbyname_r='undef'
d_getservbyport_r='undef'
d_getservent_r='undef'
d_getservprotos='define'
d_getspnam='define'
d_getspnam_r='undef'
d_gettimeod='define'
Cross/config.sh-arm-linux-n770 view on Meta::CPAN
gethostent_r_proto='0'
getlogin_r_proto='0'
getnetbyaddr_r_proto='0'
getnetbyname_r_proto='0'
getnetent_r_proto='0'
getprotobyname_r_proto='0'
getprotobynumber_r_proto='0'
getprotoent_r_proto='0'
getpwent_r_proto='0'
getpwnam_r_proto='0'
getpwuid_r_proto='0'
getservbyname_r_proto='0'
getservbyport_r_proto='0'
getservent_r_proto='0'
getspnam_r_proto='0'
gidformat='"lu"'
gidsign='1'
gidsize='4'
gidtype='gid_t'
glibpth='/usr/shlib /lib /usr/lib /usr/lib/386 /lib/386 /usr/ccs/lib /usr/ucblib /usr/local/lib '
gmake='gmake'
Porting/Glossary view on Meta::CPAN
d_getpwent_r (d_getpwent_r.U):
This variable conditionally defines the HAS_GETPWENT_R symbol,
which indicates to the C program that the getpwent_r()
routine is available.
d_getpwnam_r (d_getpwnam_r.U):
This variable conditionally defines the HAS_GETPWNAM_R symbol,
which indicates to the C program that the getpwnam_r()
routine is available.
d_getpwuid_r (d_getpwuid_r.U):
This variable conditionally defines the HAS_GETPWUID_R symbol,
which indicates to the C program that the getpwuid_r()
routine is available.
d_getsbyname (d_getsrvby.U):
This variable conditionally defines the HAS_GETSERVBYNAME
symbol, which indicates to the C program that the
getservbyname() routine is available to look up services
by their name.
d_getsbyport (d_getsrvby.U):
This variable conditionally defines the HAS_GETSERVBYPORT
Porting/Glossary view on Meta::CPAN
It is zero if d_getpwent_r is undef, and one of the
REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r
is defined.
getpwnam_r_proto (d_getpwnam_r.U):
This variable encodes the prototype of getpwnam_r.
It is zero if d_getpwnam_r is undef, and one of the
REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
is defined.
getpwuid_r_proto (d_getpwuid_r.U):
This variable encodes the prototype of getpwuid_r.
It is zero if d_getpwuid_r is undef, and one of the
REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
is defined.
getservbyname_r_proto (d_getservbyname_r.U):
This variable encodes the prototype of getservbyname_r.
It is zero if d_getservbyname_r is undef, and one of the
REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
is defined.
getservbyport_r_proto (d_getservbyport_r.U):
This variable encodes the prototype of getservbyport_r.
Porting/config.sh view on Meta::CPAN
d_getppid='define'
d_getprior='define'
d_getprotobyname_r='define'
d_getprotobynumber_r='define'
d_getprotoent_r='define'
d_getprotoprotos='define'
d_getprpwnam='undef'
d_getpwent='define'
d_getpwent_r='define'
d_getpwnam_r='define'
d_getpwuid_r='define'
d_getsbyname='define'
d_getsbyport='define'
d_getsent='define'
d_getservbyname_r='define'
d_getservbyport_r='define'
d_getservent_r='define'
d_getservprotos='define'
d_getspnam='define'
d_getspnam_r='define'
d_gettimeod='define'
Porting/config.sh view on Meta::CPAN
gethostent_r_proto='REENTRANT_PROTO_I_SBWRE'
getlogin_r_proto='REENTRANT_PROTO_I_BW'
getnetbyaddr_r_proto='REENTRANT_PROTO_I_uISBWRE'
getnetbyname_r_proto='REENTRANT_PROTO_I_CSBWRE'
getnetent_r_proto='REENTRANT_PROTO_I_SBWRE'
getprotobyname_r_proto='REENTRANT_PROTO_I_CSBWR'
getprotobynumber_r_proto='REENTRANT_PROTO_I_ISBWR'
getprotoent_r_proto='REENTRANT_PROTO_I_SBWR'
getpwent_r_proto='REENTRANT_PROTO_I_SBWR'
getpwnam_r_proto='REENTRANT_PROTO_I_CSBWR'
getpwuid_r_proto='REENTRANT_PROTO_I_TSBWR'
getservbyname_r_proto='REENTRANT_PROTO_I_CCSBWR'
getservbyport_r_proto='REENTRANT_PROTO_I_ICSBWR'
getservent_r_proto='REENTRANT_PROTO_I_SBWR'
getspnam_r_proto='REENTRANT_PROTO_I_CSBWR'
gidformat='"u"'
gidsign='1'
gidsize='4'
gidtype='gid_t'
glibpth='/usr/shlib /lib /usr/lib /usr/lib/386 /lib/386 /usr/ccs/lib /usr/ucblib /usr/local/lib /lib64 /usr/lib64 /usr/local/lib64 '
gmake='gmake'
Porting/config_H view on Meta::CPAN
/* GETPWNAM_R_PROTO:
* This symbol encodes the prototype of getpwnam_r.
* It is zero if d_getpwnam_r is undef, and one of the
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
* is defined.
*/
/*#define HAS_GETPWNAM_R / **/
#define GETPWNAM_R_PROTO 0 /**/
/* HAS_GETPWUID_R:
* This symbol, if defined, indicates that the getpwuid_r routine
* is available to getpwuid re-entrantly.
*/
/* GETPWUID_R_PROTO:
* This symbol encodes the prototype of getpwuid_r.
* It is zero if d_getpwuid_r is undef, and one of the
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
* is defined.
*/
/*#define HAS_GETPWUID_R / **/
#define GETPWUID_R_PROTO 0 /**/
/* HAS_GETSERVBYNAME_R:
* This symbol, if defined, indicates that the getservbyname_r routine
* is available to getservbyname re-entrantly.
*/
/* GETSERVBYNAME_R_PROTO:
config_h.SH view on Meta::CPAN
/* GETPWNAM_R_PROTO:
* This symbol encodes the prototype of getpwnam_r.
* It is zero if d_getpwnam_r is undef, and one of the
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r
* is defined.
*/
#$d_getpwnam_r HAS_GETPWNAM_R /**/
#define GETPWNAM_R_PROTO $getpwnam_r_proto /**/
/* HAS_GETPWUID_R:
* This symbol, if defined, indicates that the getpwuid_r routine
* is available to getpwuid re-entrantly.
*/
/* GETPWUID_R_PROTO:
* This symbol encodes the prototype of getpwuid_r.
* It is zero if d_getpwuid_r is undef, and one of the
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r
* is defined.
*/
#$d_getpwuid_r HAS_GETPWUID_R /**/
#define GETPWUID_R_PROTO $getpwuid_r_proto /**/
/* HAS_GETSERVBYNAME_R:
* This symbol, if defined, indicates that the getservbyname_r routine
* is available to getservbyname re-entrantly.
*/
/* GETSERVBYNAME_R_PROTO:
* This symbol encodes the prototype of getservbyname_r.
* It is zero if d_getservbyname_r is undef, and one of the
* REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r
* is defined.
configure.com view on Meta::CPAN
$! VMS V7.3-2 powered options
$! We know that it is only available for V7.3-2 and later on 64 bit platforms.
$!
$ d_getgrgid_r = "undef"
$ getgrgid_r_proto = "0"
$ d_getgrnam_r = "undef"
$ getgrnam_r_proto = "0"
$ d_getpgid = "undef"
$ d_getpgrp = "undef"
$! N.B. We already have home-grown thread-safe versions of
$! getpwnam and getpwuid -- no need to use CRTL versions
$ d_getpwnam_r = "undef"
$ getpwnam_r_proto = "0"
$ d_getpwuid_r = "undef"
$ getpwuid_r_proto = "0"
$ echo "Asumming 64-bit OpenVMS ''vms_ver' -- will build with V7.3-2 routines"
$ d_getgrgid_r = "define"
$ getgrgid_r_proto = "1"
$ d_getgrnam_r = "define"
$ getgrnam_r_proto = "1"
$ if d_symlink .or. d_symlink .EQS. "define"
$ then
$! FIXME: Need to find how to activate this.
$! d_getpgid = "define"
$! d_getpgrp = "define"
configure.com view on Meta::CPAN
$ WC "d_gethostent_r='undef'"
$ WC "d_getlogin_r='define'"
$ WC "d_getnetbyaddr_r='undef'"
$ WC "d_getnetbyname_r='undef'"
$ WC "d_getnetent_r='undef'"
$ WC "d_getprotobyname_r='undef'"
$ WC "d_getprotobynumber_r='undef'"
$ WC "d_getprotoent_r='undef'"
$ WC "d_getpwent_r='undef'"
$ WC "d_getpwnam_r='" + d_getpwnam_r + "'"
$ WC "d_getpwuid_r='" + d_getpwuid_r + "'"
$ WC "d_getservbyname_r='undef'"
$ WC "d_getservbyport_r='undef'"
$ WC "d_getservent_r='undef'"
$ WC "d_getspnam_r='undef'"
$ WC "d_gmtime_r='undef'" ! leave undef'd; we use my_gmtime
$ WC "d_lgamma_r='undef'"
$ WC "d_localtime_r='undef'" ! leave undef'd; we use my_localtime
$ WC "d_localtime_r_needs_tzset='undef'"
$ WC "d_newlocale='undef'"
$ WC "d_querylocale='undef'"
configure.com view on Meta::CPAN
$ WC "getlogin_r_proto='0'"
$ ENDIF
$ WC "getnetbyaddr_r_proto='0'"
$ WC "getnetbyname_r_proto='0'"
$ WC "getnetent_r_proto='0'"
$ WC "getprotobyname_r_proto='0'"
$ WC "getprotobynumber_r_proto='0'"
$ WC "getprotoent_r_proto='0'"
$ WC "getpwent_r_proto='0'"
$ WC "getpwnam_r_proto='0'"
$ WC "getpwuid_r_proto='0'"
$ WC "getservbyname_r_proto='0'"
$ WC "getservbyport_r_proto='0'"
$ WC "getservent_r_proto='0'"
$ WC "getspnam_r_proto='0'"
$ WC "gmtime_r_proto='0'"
$ WC "localtime_r_proto='0'"
$ WC "random_r_proto='0'"
$ WC "readdir_r_proto='REENTRANT_PROTO_I_TSR'" ! always defined; we roll our own
$ WC "readdir64_r_proto='0'"
$ WC "setgrent_r_proto='0'"
cpan/Archive-Tar/lib/Archive/Tar/Constant.pm view on Meta::CPAN
use constant BLOCK_SIZE => sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK };
use constant TAR_PAD => sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) };
use constant TAR_END => "\0" x BLOCK;
use constant READ_ONLY => sub { shift() ? 'rb' : 'r' };
use constant WRITE_ONLY => sub { $_[0] ? 'wb' . shift : 'w' };
use constant MODE_READ => sub { $_[0] =~ /^r/ ? 1 : 0 };
# Pointless assignment to make -w shut up
my $getpwuid; $getpwuid = 'unknown' unless eval { my $f = getpwuid (0); };
my $getgrgid; $getgrgid = 'unknown' unless eval { my $f = getgrgid (0); };
use constant UNAME => sub { $getpwuid || scalar getpwuid( shift() ) || '' };
use constant GNAME => sub { $getgrgid || scalar getgrgid( shift() ) || '' };
use constant UID => $>;
use constant GID => (split ' ', $) )[0];
use constant MODE => do { 0666 & (0777 & ~umask) };
use constant STRIP_MODE => sub { shift() & 0777 };
use constant CHECK_SUM => " ";
use constant UNPACK => 'a100 a8 a8 a8 a12 a12 a8 a1 a100 A6 a2 a32 a32 a8 a8 a155 x12'; # cdrake - size must be a12 - not A12 - or else screws up huge file sizes (>8gb)
use constant PACK => 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
cpan/CPAN/lib/CPAN/FTP.pm view on Meta::CPAN
eval {
chmod $stat[2], $dest
or $CPAN::Frontend->mywarn("Can't chmod '$dest' to " . sprintf("0%o", $stat[2]) . ": $!\n");
};
warn $@ if $@;
eval {
chown $stat[4], $stat[5], $dest
or do {
my $save_err = $!; # otherwise it's lost in the get... calls
$CPAN::Frontend->mywarn("Can't chown '$dest' to " .
(getpwuid($stat[4]))[0] . "/" .
(getgrgid($stat[5]))[0] . ": $save_err\n"
);
};
};
warn $@ if $@;
}
# if file is CHECKSUMS, suggest the place where we got the file to be
# checked from, maybe only for young files?
#-> sub CPAN::FTP::_recommend_url_for
cpan/CPAN/lib/CPAN/FirstTime.pm view on Meta::CPAN
# local::lib thinks the user's home is
{
my $local_lib_home;
sub _local_lib_home {
$local_lib_home ||= File::Spec->rel2abs( do {
if ($CPAN::META->has_usable("File::HomeDir") && File::HomeDir->VERSION >= 0.65) {
File::HomeDir->my_home;
} elsif (defined $ENV{HOME}) {
$ENV{HOME};
} else {
(getpwuid $<)[7] || "~";
}
});
}
}
sub _do_pick_mirrors {
local *_real_prompt;
*_real_prompt = \&CPAN::Shell::colorable_makemaker_prompt;
$CPAN::Frontend->myprint($prompts{urls_intro});
# Only prompt for auto-pick if Net::Ping is new enough to do timings
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm view on Meta::CPAN
foreach (@args) {
unless (m/(.*?)=(.*)/) {
++$Verbose if m/^verb/;
next;
}
my($name, $value) = ($1, $2);
if ($value =~ m/^~(\w+)?/) { # tilde with optional username
$value =~ s [^~(\w*)]
[$1 ?
((getpwnam($1))[7] || "~$1") :
(getpwuid($>))[7]
]ex;
}
# Remember the original args passed it. It will be useful later.
$self->{ARGS}{uc $name} = $self->{uc $name} = $value;
}
# catch old-style 'potential_libs' and inform user how to 'upgrade'
if (defined $self->{potential_libs}){
my($msg)="'potential_libs' => '$self->{potential_libs}' should be";
cpan/File-Path/t/Path.t view on Meta::CPAN
'make_path with final hashref warned due to options implausible on Win32'
);
}
is(scalar(@created), 3, "Provide valid 'uid' argument: 3 subdirectories created");
cleanup_3_level_subdirs($least_deep);
}
SKIP: {
my $skip_count = 3;
skip "getpwuid() and getgrgid() not implemented on Windows", $skip_count
if $^O eq 'MSWin32';
# mkpath() with hashref: case of valid owner
my ($least_deep, $next_deepest, $deepest) =
create_3_level_subdirs( qw| aiJEDKaAEH25 nqhXsBM_7_bv qfRj4cur4Jrs | );
my (@created, $error);
my $name = getpwuid($>);
@created = mkpath($deepest, { mode => 0711, owner => $name, error => \$error });
is(scalar(@created), 3, "Provide valid 'owner' argument: 3 subdirectories created");
cleanup_3_level_subdirs($least_deep);
}
SKIP: {
my $skip_count = 5;
skip "Windows will not set this error condition", $skip_count
if $^O eq 'MSWin32';
cpan/File-Path/t/Path.t view on Meta::CPAN
'make_path with final hashref warned due to options implausible on Win32'
);
}
is(scalar(@created), 3, "Provide valid 'group' argument: 3 subdirectories created");
cleanup_3_level_subdirs($least_deep);
}
SKIP: {
my $skip_count = 3;
skip "getpwuid() and getgrgid() not implemented on Windows", $skip_count
if $^O eq 'MSWin32';
# mkpath() with hashref: case of valid group
my ($least_deep, $next_deepest, $deepest) =
create_3_level_subdirs( qw| IayhWFDvys8X gTd6gaeuFzmV VVI6UWLJCOEC | );
my (@created, $error);
my $group_name = (getgrgid($())[0];
@created = mkpath($deepest, { mode => 0711, group => $group_name, error => \$error });
is(scalar(@created), 3, "Provide valid 'group' argument: 3 subdirectories created");
cleanup_3_level_subdirs($least_deep);
}
SKIP: {
my $skip_count = 3;
skip "getpwuid() and getgrgid() not implemented on Windows", $skip_count
if $^O eq 'MSWin32';
# mkpath() with hashref: case of valid owner and group
my ($least_deep, $next_deepest, $deepest) =
create_3_level_subdirs( qw| xsmOvlnxOqJc olsGlBSoVUpp tDuRilkD35rd | );
my (@created, $error);
my $name = getpwuid($>);
my $group_name = (getgrgid($())[0];
@created = mkpath($deepest, { mode => 0711, owner => $name, group => $group_name, error => \$error });
is(scalar(@created), 3, "Provide valid 'owner' and 'group' 'group' arguments: 3 subdirectories created");
cleanup_3_level_subdirs($least_deep);
}
cpan/Pod-Simple/t/perlfaq.pod view on Meta::CPAN
# identify text files
perl -le 'for(@ARGV) {print if -f && -T _}' *
# remove (most) comments from C program
perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c
# make file a month younger than today, defeating reaper daemons
perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' *
# find first unused uid
perl -le '$i++ while getpwuid($i); print $i'
# display reasonable manpath
echo $PATH | perl -nl -072 -e '
s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}'
OK, the last one was actually an Obfuscated Perl Contest entry. :-)
=head2 Why don't Perl one-liners work on my DOS/Mac/VMS system?
The problem is usually that the command interpreters on those systems
cpan/Pod-Simple/t/perlfaqo.txt view on Meta::CPAN
Yes. Read perlrun for more information. Some examples follow. (These assume standard Unix shell quoting rules.)
# sum first and last fields
perl -lane 'print $F[0] + $F[-1]' *
# identify text files
perl -le 'for(@ARGV) {print if -f && -T _}' *
# remove (most) comments from C program
perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c
# make file a month younger than today, defeating reaper daemons
perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' *
# find first unused uid
perl -le '$i++ while getpwuid($i); print $i'
# display reasonable manpath
echo $PATH | perl -nl -072 -e '
s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}'
OK, the last one was actually an Obfuscated Perl Contest entry. :-)
Why don't Perl one-liners work on my DOS/Mac/VMS system?
The problem is usually that the command interpreters on those systems have rather different ideas about quoting than the Unix shells under which the one-liners were created. On some systems, you may have to change single-quotes to double ones, which ...
For example:
# Unix
perl -e 'print "Hello world\n"'
# DOS, etc.
cpan/Sys-Syslog/Syslog.pm view on Meta::CPAN
no strict 'refs';
*$AUTOLOAD = sub { $val };
goto &$AUTOLOAD;
}
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}
}
$err_sub = delete $options{nofatal} ? \&warnings::warnif : \&croak;
return 1 unless $options{ndelay};
connect_log();
cpan/libnet/lib/Net/Config.pm view on Meta::CPAN
my $ref;
$file =~ s/Config.pm/libnet.cfg/;
if (-f $file) {
$ref = eval { local $SIG{__DIE__}; do $file };
if (ref($ref) eq 'HASH') {
%NetConfig = (%NetConfig, %{$ref});
$LIBNET_CFG = $file;
}
}
if ($< == $> and !$CONFIGURE) {
my $home = eval { local $SIG{__DIE__}; (getpwuid($>))[7] } || $ENV{HOME};
$home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH} || '') if defined $ENV{HOMEDRIVE};
if (defined $home) {
$file = $home . "/.libnetrc";
$ref = eval { local $SIG{__DIE__}; do $file } if -f $file;
%NetConfig = (%NetConfig, %{$ref})
if ref($ref) eq 'HASH';
}
}
my ($k, $v);
while (($k, $v) = each %NetConfig) {
cpan/libnet/lib/Net/FTP.pm view on Meta::CPAN
$ftp->_ACCT($acct) == CMD_OK;
}
sub _auth_id {
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()
if ($rc);
}
($ftp, $auth, $resp);
}
cpan/libnet/lib/Net/Netrc.pm view on Meta::CPAN
my($class, $host) = @_;
my ($home, $file);
if ($^O eq "MacOS") {
$home = $ENV{HOME} || `pwd`;
chomp($home);
$file = ($home =~ /:$/ ? $home . "netrc" : $home . ":netrc");
}
else {
# Some OS's don't have "getpwuid", so we default to $ENV{HOME}
$home = eval { (getpwuid($>))[7] } || $ENV{HOME};
$home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH} || '') if defined $ENV{HOMEDRIVE};
if (-e $home . "/.netrc") {
$file = $home . "/.netrc";
}
elsif (-e $home . "/_netrc") {
$file = $home . "/_netrc";
}
else {
return unless $TESTING;
}
cpan/libnet/lib/Net/POP3.pm view on Meta::CPAN
($1 || 0, $2 || 0);
}
sub _lookup_credentials {
my ($me, $user) = @_;
require Net::Netrc;
$user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] }
|| $ENV{NAME}
|| $ENV{USER}
|| $ENV{LOGNAME};
my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'}, $user);
$m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
my $pass = $m
? $m->password || ""
: "";
cpan/libnet/t/netrc.t view on Meta::CPAN
plan tests => 20;
}
}
use Cwd;
# for testing _readrc
$ENV{HOME} = Cwd::cwd();
# avoid "used only once" warning
local (*CORE::GLOBAL::getpwuid, *CORE::GLOBAL::stat);
*CORE::GLOBAL::getpwuid = sub ($) {
((undef) x 7, Cwd::cwd());
};
# for testing _readrc
my @stat;
*CORE::GLOBAL::stat = sub (*) {
return @stat;
};
# for testing _readrc
cpan/perlfaq/lib/perlfaq3.pod view on Meta::CPAN
# identify text files
perl -le 'for(@ARGV) {print if -f && -T _}' *
# remove (most) comments from C program
perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c
# make file a month younger than today, defeating reaper daemons
perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' *
# find first unused uid
perl -le '$i++ while getpwuid($i); print $i'
# display reasonable manpath
echo $PATH | perl -nl -072 -e '
s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}'
OK, the last one was actually an Obfuscated Perl Contest entry. :-)
=head2 Why don't Perl one-liners work on my DOS/Mac/VMS system?
The problem is usually that the command interpreters on those systems
cpan/perlfaq/lib/perlfaq9.pod view on Meta::CPAN
The L<Email::MIME> module can decode base 64-encoded email message parts
transparently so the developer doesn't need to worry about it.
=head2 How do I find the user's mail address?
Ask them for it. There are so many email providers available that it's
unlikely the local system has any idea how to determine a user's email address.
The exception is for organization-specific email (e.g. foo@yourcompany.com)
where policy can be codified in your program. In that case, you could look at
$ENV{USER}, $ENV{LOGNAME}, and getpwuid($<) in scalar context, like so:
my $user_name = getpwuid($<)
But you still cannot make assumptions about whether this is correct, unless
your policy says it is. You really are best off asking the user.
=head2 How do I send email?
Use the L<Email::Stuffer> module, like so:
# first, create your message
my $message = Email::Stuffer->from('you@example.com')
dist/Devel-PPPort/parts/base/5003007 view on Meta::CPAN
KEY_getnetent # Z added by devel/scanprov
KEY_getpeername # Z added by devel/scanprov
KEY_getpgrp # Z added by devel/scanprov
KEY_getppid # Z added by devel/scanprov
KEY_getpriority # Z added by devel/scanprov
KEY_getprotobyname # Z added by devel/scanprov
KEY_getprotobynumber # Z added by devel/scanprov
KEY_getprotoent # Z added by devel/scanprov
KEY_getpwent # Z added by devel/scanprov
KEY_getpwnam # Z added by devel/scanprov
KEY_getpwuid # Z added by devel/scanprov
KEY_getservbyname # Z added by devel/scanprov
KEY_getservbyport # Z added by devel/scanprov
KEY_getservent # Z added by devel/scanprov
KEY_getsockname # Z added by devel/scanprov
KEY_getsockopt # Z added by devel/scanprov
KEY_glob # Z added by devel/scanprov
KEY_gmtime # Z added by devel/scanprov
KEY_goto # Z added by devel/scanprov
KEY_grep # Z added by devel/scanprov
KEY_gt # Z added by devel/scanprov
dist/Devel-PPPort/parts/base/5009000 view on Meta::CPAN
DEBUG_C_FLAG # Z added by devel/scanprov
DEBUG_C_TEST # Z added by devel/scanprov
dMY_CXT # E
endgrent # Z added by devel/scanprov
endpwent # Z added by devel/scanprov
getgrent # Z added by devel/scanprov
getgrgid # Z added by devel/scanprov
getgrnam # Z added by devel/scanprov
getpwent # Z added by devel/scanprov
getpwnam # Z added by devel/scanprov
getpwuid # Z added by devel/scanprov
getspnam # Z added by devel/scanprov
hek_dup # U
MY_CXT # E
MY_CXT_INIT # E
new_version # U
parser_dup # E
Perl_my_cxt_init # U
Perl_sv_free2 # F added by devel/scanprov
PL_cv_has_eval # Z added by devel/scanprov
pMY_CXT # E
dist/Safe/t/safeops.t view on Meta::CPAN
gservent getservent
shostent sethostent
snetent setnetent
sprotoent setprotoent
sservent setservent
ehostent endhostent
enetent endnetent
eprotoent endprotoent
eservent endservent
gpwnam getpwnam
gpwuid getpwuid
gpwent getpwent
spwent setpwent
epwent endpwent
ggrnam getgrnam
ggrgid getgrgid
ggrent getgrent
sgrent setgrent
egrent endgrent
getlogin getlogin
syscall syscall
ext/File-Glob/bsd_glob.c view on Meta::CPAN
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include "bsd_glob.h"
#ifdef I_PWD
# include <pwd.h>
#else
#if defined(HAS_PASSWD) && !defined(VMS)
struct passwd *getpwnam(char *);
struct passwd *getpwuid(Uid_t);
#endif
#endif
#ifndef MAXPATHLEN
# ifdef PATH_MAX
# define MAXPATHLEN PATH_MAX
# else
# define MAXPATHLEN 1024
# endif
#endif
ext/File-Glob/bsd_glob.c view on Meta::CPAN
if (((char *) patbuf)[0] == BG_EOS) {
/*
* handle a plain ~ or ~/ by expanding $HOME
* first and then trying the password file
* or $USERPROFILE on DOSISH systems
*/
if ((h = PerlEnv_getenv("HOME")) == NULL) {
#ifdef HAS_PASSWD
struct passwd *pwd;
if ((pwd = getpwuid(getuid())) == NULL)
return pattern;
else
h = pwd->pw_dir;
#elif DOSISH
/*
* When no passwd file, fallback to the USERPROFILE
* environment variable on DOSish systems.
*/
if ((h = PerlEnv_getenv("USERPROFILE")) == NULL) {
return pattern;
ext/File-Glob/t/basic.t view on Meta::CPAN
# look up the user's home directory
# should return a list with one item, and not set ERROR
my @a;
SKIP: {
my ($name, $home);
skip $^O, 2 if $^O eq 'MSWin32' || $^O eq 'VMS'
|| $^O eq 'os2';
skip "Can't find user for $>: $@", 2 unless eval {
($name, $home) = (getpwuid($>))[0,7];
1;
};
skip "$> has no home directory", 2
unless defined $home && defined $name && -d $home;
@a = bsd_glob("~$name", GLOB_TILDE);
if (GLOB_ERROR) {
fail(GLOB_ERROR);
} else {
ext/File-Glob/t/basic.t view on Meta::CPAN
{
my $tilde_check = sub {
my @a = bsd_glob('~');
if (GLOB_ERROR) {
fail(GLOB_ERROR);
} else {
is_deeply (\@a, [$_[0]], join ' - ', 'tilde expansion', @_ > 1 ? $_[1] : ());
}
};
my $passwd_home = eval { (getpwuid($>))[7] };
TODO: {
local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS';
local $ENV{HOME};
delete $ENV{HOME};
local $ENV{USERPROFILE};
delete $ENV{USERPROFILE};
$tilde_check->(defined $passwd_home ? $passwd_home : q{~}, 'no environment');
}
ext/File-Glob/t/basic.t view on Meta::CPAN
local $ENV{HOME};
delete $ENV{HOME};
local $ENV{USERPROFILE};
$ENV{USERPROFILE} = 'sweet win32 home';
$tilde_check->(defined $passwd_home ? $passwd_home : $ENV{USERPROFILE}, 'USERPROFILE');
}
TODO: {
local $TODO = 'directory brackets look like pattern brackets to glob' if $^O eq 'VMS';
my $home = exists $ENV{HOME} ? $ENV{HOME}
: eval { getpwuid($>); 1 } ? (getpwuid($>))[7]
: $^O eq 'MSWin32' && exists $ENV{USERPROFILE} ? $ENV{USERPROFILE}
: q{~};
$tilde_check->($home);
}
}
# check backslashing
# should return a list with one item, and not set ERROR
@a = bsd_glob('TEST', GLOB_QUOTE);
if (GLOB_ERROR) {
ext/POSIX/lib/POSIX.pm view on Meta::CPAN
geteuid => '$> + 0',
getgid => '$( + 0',
getgrgid => 'gid => CORE::getgrgid($_[0])',
getgrnam => 'name => CORE::getgrnam($_[0])',
getgroups => 'my %seen; grep !$seen{$_}++, split " ", $)',
getlogin => 'CORE::getlogin()',
getpgrp => 'CORE::getpgrp',
getpid => '$$',
getppid => 'CORE::getppid',
getpwnam => 'name => CORE::getpwnam($_[0])',
getpwuid => 'uid => CORE::getpwuid($_[0])',
gets => 'scalar <STDIN>',
getuid => '$<',
gmtime => 'time => CORE::gmtime($_[0])',
isatty => 'filehandle => -t $_[0]',
kill => 'pid, sig => CORE::kill $_[1], $_[0]',
link => 'oldfilename, newfilename => CORE::link($_[0], $_[1])',
localtime => 'time => CORE::localtime($_[0])',
log => 'x => CORE::log($_[0])',
mkdir => 'directoryname, mode => CORE::mkdir($_[0], $_[1])',
opendir => 'directory => my $dh; CORE::opendir($dh, $_[0]) ? $dh : undef',
ext/POSIX/lib/POSIX.pod view on Meta::CPAN
This is identical to Perl's builtin C<getppid()> function for
returning the process identifier of the parent process of the current
process , see L<perlfunc/getppid>.
=item C<getpwnam>
This is identical to Perl's builtin C<getpwnam()> function for
returning user entries by user names, see L<perlfunc/getpwnam>.
=item C<getpwuid>
This is identical to Perl's builtin C<getpwuid()> function for
returning user entries by user identifiers, see L<perlfunc/getpwuid>.
=item C<gets>
Returns one line from C<STDIN>, similar to E<lt>E<gt>, also known
as the C<readline()> function, see L<perlfunc/readline>.
B<NOTE>: if you have C programs that still use C<gets()>, be very
afraid. The C<gets()> function is a source of endless grief because
it has no buffer overrun checks. It should B<never> be used. The
C<fgets()> function should be preferred instead.
( run in 0.500 second using v1.01-cache-2.11-cpan-454fe037f31 )