Result:
found more than 693 distributions - search limited to the first 2001 files matching your query
( run in 2.642 )
App-WordPressTools
view release on metacpan or search on metacpan
script/wp-tools view on Meta::CPAN
if ($dproc > $args->{'max_dproc'}) {
die 'Process queue full, please try again later.';
}
}
my ($uid, $gid, $home_dir);
### determine who we are or should be running as
if ($< == 0) {
if (!$args->{'username'}) {
help(1, "You cannot $command a WordPress installation as a root user");
}
($uid, $gid, $home_dir) = (getpwnam $args->{'username'})[2, 3, 7];
}
else {
my $username;
($username, $uid, $gid, $home_dir) = (getpwuid $<)[0, 2, 3, 7];
$args->{'username'} = $username if !$args->{'username'};
}
### check space and average IO wait time of the home partition
if (my ($homeslash) = $home_dir =~ m{^(/home\d+)/} and !$args->{force}) {
script/wp-tools view on Meta::CPAN
### drop permissions
if ($< == 0) {
#dmother
#added use English; equivalent statements for clarity
#keeping punctuation variables for speed
#$REAL_GROUP_ID = $EFFECTIVE_GROUP_ID = "$gid $gid";
$( = $) = "$gid $gid";
#$REAL_USER_ID = $EFFECTIVE_USER_ID = $uid;
$< = $> = $uid;
#cannot perform this action as root
if ($< == 0) {
die "Failed to relinquish privileges to user $args->{'username'}: $!";
App-Yabsm
view release on metacpan or search on metacpan
lib/App/Yabsm/Command/Config.pm view on Meta::CPAN
unless (App::Yabsm::Command::Daemon::yabsm_group_exists()) {
die q(yabsm: error: cannot find group named 'yabsm')."\n";
}
POSIX::setgid(scalar(getgrnam 'yabsm'));
POSIX::setuid(scalar(getpwnam 'yabsm'));
App::Yabsm::Backup::SSH::check_ssh_backup_config_or_die(undef, $ssh_backup, $config_ref);
say 'all good';
App-ZodiacUtils
view release on metacpan or search on metacpan
script/_chinese-zodiac-of view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-a2p
view release on metacpan or search on metacpan
lib/App/a2p.pm view on Meta::CPAN
specifies the names of the input fields if input does not have to be
split into an array. If you were translating an awk script that
processes the password file, you might say:
a2p -7 -nlogin.password.uid.gid.gcos.shell.home
Any delimiter can be used to separate the field names.
=item B<-E<lt>numberE<gt>>
App-diceware
view release on metacpan or search on metacpan
share/wordlist_de.tsv view on Meta::CPAN
12434 adria
12435 adv
12436 advent
12441 adverb
12442 ae
12443 aegide
12444 aehre
12445 aelter
12446 aeon
12451 aerger
12452 aermel
App-find2perl
view release on metacpan or search on metacpan
script/find2perl view on Meta::CPAN
my $uname = shift;
$out .= tab . "(\$uid == \$uid{'$uname'})";
$init{user} = 1;
} elsif ($_ eq 'group') {
my $gname = shift;
$out .= tab . "(\$gid == \$gid{'$gname'})";
$init{group} = 1;
} elsif ($_ eq 'nouser') {
$out .= tab . '!exists $uid{$uid}';
$init{user} = 1;
} elsif ($_ eq 'nogroup') {
$out .= tab . '!exists $gid{$gid}';
$init{group} = 1;
} elsif ($_ eq 'links') {
$out .= tab . n('$nlink', shift);
} elsif ($_ eq 'inum') {
$out .= tab . n('$ino', shift);
script/find2perl view on Meta::CPAN
if exists $init{ls} || exists $init{tar};
print "}\n\n";
}
if (exists $init{group} || exists $init{ls} || exists $init{tar}) {
print "my (%gid, %group);\n";
print "while (my (\$name, \$pw, \$gid) = getgrent) {\n";
print ' $gid{$name} = $gid{$gid} = $gid;', "\n"
if exists $init{group};
print ' $group{$gid} = $name unless exists $group{$gid};', "\n"
if exists $init{ls} || exists $init{tar};
print "}\n\n";
}
print $initnewer, "\n" if $initnewer ne '';
print $initfile, "\n" if $initfile ne '';
$flushall .= "exit;\n";
if (exists $init{declarestat}) {
$out = <<'END' . $out;
my ($dev,$ino,$mode,$nlink,$uid,$gid);
END
}
if ( $follow_in_effect ) {
script/find2perl view on Meta::CPAN
my $rdev = shift;
sprintf("%3d, %3d", ($rdev >> 8) & 0xff, $rdev & 0xff);
}
sub ls () {
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
INTRO
\$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
SUB
my $pname = $name;
script/find2perl view on Meta::CPAN
elsif (-p _) { $perms = 'p' . $perms; }
elsif (-S _) { $perms = 's' . $perms; }
else { $perms = '?' . $perms; }
my $user = $user{$uid} || $uid;
my $group = $group{$gid} || $gid;
my ($sec,$min,$hour,$mday,$mon,$timeyear) = localtime($mtime);
if (-M _ > 365.25 / 2) {
$timeyear += 1900;
} else {
script/find2perl view on Meta::CPAN
my %nc = ();
sub cpio {
my ($fh, $fname, $nc) = @_;
my $text = '';
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks);
local (*IN);
if ( ! defined $fname ) {
$fname = 'TRAILER!!!';
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = (0) x 13;
} else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
INTRO
\$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
SUB
if (-f _) {
open(IN, "./$_\0") || do {
script/find2perl view on Meta::CPAN
070707,
$dev & 0777777,
$ino & 0777777,
$mode & 0777777,
$uid & 0777777,
$gid & 0777777,
$nlink & 0777777,
$rdev & 0177777,
$mtime,
length($fname)+1,
$size,
$fname);
} else {
$cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
$cpout{$fh} .= pack("SSSSSSSSLSLa*",
070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
length($fname)+1, $size,
$fname . (length($fname) & 1 ? "\0" : "\0\0"));
}
if ($text ne '') {
script/find2perl view on Meta::CPAN
sub tar {
my ($fh, $fname) = @_;
my $prefix = '';
my $typeflag = '0';
my $linkname;
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
INTRO
\$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
SUB
local (*IN);
script/find2perl view on Meta::CPAN
$size = 0 if $typeflag ne '0';
my $header = pack("a100a8a8a8a12a12a8a1a100a6a2a32a32a8a8a155",
$fname,
sprintf("%7o ", $mode & 0777),
sprintf("%7o ", $uid & 0777777),
sprintf("%7o ", $gid & 0777777),
sprintf("%11o ", $size),
sprintf("%11o ", $mtime),
' 'x8,
$typeflag,
defined $linkname ? $linkname : '',
"ustar\0",
"00",
$user{$uid},
$group{$gid},
($rdev >> 8) & 0xff,
$rdev & 0xff,
$prefix,
);
substr($header, 148, 8) = sprintf("%7o ", unpack("%16C*", $header));
script/find2perl view on Meta::CPAN
$tabstring = "\t" x ($indent_depth/2) . ' ' x ($indent_depth%2 * 4);
if (!$statdone) {
if ($_ =~ /^(?:name|print|prune|exec|ok|\(|\))/) {
$init{delayedstat} = 1;
} else {
my $statcall = '(($dev,$ino,$mode,$nlink,$uid,$gid) = '
. $stat . '($_))';
if (exists $init{saw_or}) {
$tabstring .= "(\$nlink || $statcall) &&\n" . $tabstring;
} else {
$tabstring .= "$statcall &&\n" . $tabstring;
App-finddo
view release on metacpan or search on metacpan
script/_finddo view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-genpw-base56
view release on metacpan or search on metacpan
script/_genpw-base56 view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-genpw-base58
view release on metacpan or search on metacpan
script/_genpw-base58 view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-genpw-base64
view release on metacpan or search on metacpan
script/_genpw-base64 view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-genpw-id
view release on metacpan or search on metacpan
script/_genpw-id view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-genpw-ind
view release on metacpan or search on metacpan
script/_genpw-ind view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-get_flash_videos
view release on metacpan or search on metacpan
lib/FlashVideo/Site/Mtvnservices.pm view on Meta::CPAN
use strict;
use FlashVideo::Utils;
use URI::Escape;
my $MTVN_URL = qr{http://\w+.mtvnservices.com/(?:\w+/)?mgid:[a-z0-9:.\-_]+};
sub find_video {
my ($self, $browser, $embed_url) = @_;
my $page_url = $browser->uri->as_string;
App-govproc-pericmd
view release on metacpan or search on metacpan
script/govproc-pericmd view on Meta::CPAN
=head2 Setuid options
=over
=item B<--egid>=I<s>
Set EGID(s) of command process.
Need to be root to be able to setuid.
script/govproc-pericmd view on Meta::CPAN
Finally, you can filter a section by environment variable using the filter C<env=CONDITION> in section names. For example if you only want a section to be read if a certain environment variable is true: C<[env=SOMEVAR ...]> or C<[SOMESECTION env=SOME...
List of available configuration parameters:
command (see --command)
egid (see --egid)
euid (see --euid)
format (see --format)
killfam (see --killfam)
load_check_every (see --load-check-every)
load_high_limit (see --load-high-limit)
App-hr
view release on metacpan or search on metacpan
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-karr
view release on metacpan or search on metacpan
lib/App/karr.pm view on Meta::CPAN
first-class runtime option for vendoring C<karr> into other repositories or
tooling environments.
The default C<raudssus/karr:latest> image starts as root only long enough to
inspect the mounted F</work> directory and then drops to the matching numeric
uid and gid before running C<karr>. This prevents root-owned project files when
the image is used through a shell alias. The companion C<raudssus/karr:user>
image is the fixed-user variant for environments that prefer a predictable
non-root runtime without that auto-adjustment.
See L<karr> and F<README.md> for the shell alias form and operator-focused
App-metasyn
view release on metacpan or search on metacpan
script/_metasyn view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-mimi
view release on metacpan or search on metacpan
mimi.fatpack view on Meta::CPAN
$fatpacked{"DBD/DBM.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DBD_DBM';
require 5.008;use strict;package DBD::DBM;use base qw(DBD::File);use vars qw($VERSION $ATTRIBUTION $drh $methods_already_installed);$VERSION='0.03';$ATTRIBUTION='DBD::DBM by Jens Rehsack';sub driver ($;$) {my ($class,$attr)=@_;return$drh if ($drh);...
DBD_DBM
$fatpacked{"DBD/ExampleP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DBD_EXAMPLEP';
{package DBD::ExampleP;use strict;use Symbol;use DBI qw(:sql_types);require File::Spec;our (@EXPORT,$VERSION,@statnames,%statnames,@stattypes,%stattypes,@statprec,%statprec,$drh,);@EXPORT=qw();$VERSION="0.03";@statnames=qw(dev ino mode nlink uid gi...
DBD_EXAMPLEP
$fatpacked{"DBD/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DBD_FILE';
require 5.008;use strict;use warnings;use DBI ();package DBD::File;use strict;use warnings;use base qw(DBI::DBD::SqlEngine);use Carp;use vars qw(@ISA $VERSION $drh);$VERSION="0.03";$drh=undef;sub driver ($;$) {my ($class,$attr)=@_;$drh->{$class}and...
DBD_FILE
App-orgdaemon
view release on metacpan or search on metacpan
bin/org2ical view on Meta::CPAN
chown $stat[4], $stat[5], $dest
or do {
my $save_err = $!; # otherwise it's lost in the get... calls
warn "Can't chown $dest to " .
(getpwuid($stat[4]))[0] . "/" .
(getgrgid($stat[5]))[0] . ": $save_err";
};
utime $stat[8], $stat[9], $dest
or warn "Can't utime $dest to " .
scalar(localtime $stat[8]) . "/" .
scalar(localtime $stat[9]) .
App-ppgrep
view release on metacpan or search on metacpan
lib/App/ppgrep.pm view on Meta::CPAN
}
if ($args{group} && @{$args{group}}) {
my $found = 0;
for (@{ $args{group} }) {
if ($_ == $p->{gid}) {
$found++; last;
}
}
do { $match = 0; last MATCHING } unless $found;
}
App-rdapper
view release on metacpan or search on metacpan
lib/App/rdapper.pm view on Meta::CPAN
}
}
}
foreach my $msg (uniq(@msgs)) {
printf("msgid \"%s\"\nmsgstr \"\"\n\n", $msg);
}
};
exit;
}
App-remarkpl
view release on metacpan or search on metacpan
lib/App/remarkpl/public/remark.min.js view on Meta::CPAN
}),e.COMMENT("#cs","#ce"),e.COMMENT("#comments-start","#comments-end")]},n={begin:"\\$[A-z0-9_]+"},i={className:"string",variants:[{begin:/"/,end:/"/,contains:[{begin:/""/,relevance:0}]},{begin:/'/,end:/'/,contains:[{begin:/''/,relevance:0}]}]},l={va...
beginKeywords:"class interface",end:/[{;=]/,illegal:/[^\s:]/,contains:[e.TITLE_MODE,e.C_LINE_COMMENT_MODE,e.C_BLOCK_COMMENT_MODE]},{beginKeywords:"namespace",end:/[{;=]/,illegal:/[^\s:]/,contains:[e.inherit(e.TITLE_MODE,{begin:"[a-zA-Z](\\.?\\w)*"}),...
},a={className:"params",begin:/\(/,end:/\)/,excludeBegin:!0,excludeEnd:!0},r={className:"symbol",variants:[{begin:/\=[lgenxc]=/},{begin:/\$/}]},s={className:"comment",variants:[{begin:"'",end:"'"},{begin:'"',end:'"'}],illegal:"\\n",contains:[e.BACKSL...
},{begin:":\\s*"+t}]}]}}},{name:"hsp",create:function(e){return{case_insensitive:!0,lexemes:/[\w\._]+/,keywords:"goto gosub return break repeat loop continue wait await dim sdim foreach dimtype dup dupptr end stop newmod delmod mref run exgoto on mca...
},contains:[t,{className:"keyword",begin:"\\bend\\sif\\b"},{className:"function",beginKeywords:"function",end:"$",contains:[t,s,e.APOS_STRING_MODE,e.QUOTE_STRING_MODE,e.BINARY_NUMBER_MODE,e.C_NUMBER_MODE,r]},{className:"function",begin:"\\bend\\s+",e...
contains:[{className:"comment",begin:/\(\*/,end:/\*\)/},e.APOS_STRING_MODE,e.QUOTE_STRING_MODE,e.C_NUMBER_MODE,{begin:/\{/,end:/\}/,illegal:/:/}]}}},{name:"matlab",create:function(e){var t=[e.C_NUMBER_MODE,{className:"string",begin:"'",end:"'",contai...
illegal:"</",contains:[e.C_NUMBER_MODE,e.APOS_STRING_MODE,e.QUOTE_STRING_MODE,{className:"string",begin:"`",end:"`",contains:[e.BACKSLASH_ESCAPE]},{begin:"[\\$\\%\\@](\\^\\w\\b|#\\w+|[^\\s\\w{]|{\\w+}|\\w+)"},e.C_LINE_COMMENT_MODE,e.C_BLOCK_COMMENT_M...
contains:[i]});return{aliases:["ps"],lexemes:/-?[A-z\.\-]+/,case_insensitive:!0,keywords:{keyword:"if else foreach return function do while until elseif begin for trap data dynamicparam end break throw param continue finally in switch exit filter try...
},{className:"meta",begin:"#\\!?\\[",end:"\\]",contains:[{className:"meta-string",begin:/"/,end:/"/}]},{className:"class",beginKeywords:"type",end:";",contains:[e.inherit(e.UNDERSCORE_TITLE_MODE,{endsParent:!0})],illegal:"\\S"},{className:"class",beg...
literal:"true false nil"},contains:[e.C_LINE_COMMENT_MODE,e.C_BLOCK_COMMENT_MODE,e.NUMBER_MODE,a,t.preprocessor],illegal:/#/}}},{name:"sql",create:function(e){var t=e.COMMENT("--","$");return{case_insensitive:!0,illegal:/[<>{}*#]/,contains:[{beginKey...
return{aliases:["styl"],case_insensitive:!1,keywords:"if else for in",illegal:"("+o.join("|")+")",contains:[e.QUOTE_STRING_MODE,e.APOS_STRING_MODE,e.C_LINE_COMMENT_MODE,e.C_BLOCK_COMMENT_MODE,a,{begin:"\\.[a-zA-Z][a-zA-Z0-9_-]*"+i,returnBegin:!0,cont...
built_in:"ip eip rip al ah bl bh cl ch dl dh sil dil bpl spl r8b r9b r10b r11b r12b r13b r14b r15b ax bx cx dx si di bp sp r8w r9w r10w r11w r12w r13w r14w r15w eax ebx ecx edx esi edi ebp esp eip r8d r9d r10d r11d r12d r13d r14d r15d rax rbx rcx rdx...
"atelier-lakeside-light":".hljs-atelier-lakeside-light .hljs-comment,.hljs-atelier-lakeside-light .hljs-quote{color:#5a7b8c}.hljs-atelier-lakeside-light .hljs-variable,.hljs-atelier-lakeside-light .hljs-template-variable,.hljs-atelier-lakeside-light ...
grayscale:".hljs-grayscale .hljs{display:block;overflow-x:auto;padding:.5em;color:#333;background:#fff}.hljs-grayscale .hljs-comment,.hljs-grayscale .hljs-quote{color:#777;font-style:italic}.hljs-grayscale .hljs-keyword,.hljs-grayscale .hljs-selector...
"solarized-dark":".hljs-solarized-dark .hljs{display:block;overflow-x:auto;padding:.5em;background:#002b36;color:#839496}.hljs-solarized-dark .hljs-comment,.hljs-solarized-dark .hljs-quote{color:#586e75}.hljs-solarized-dark .hljs-keyword,.hljs-solari...
containerLayout:'<div class="remark-notes-area">\n <div class="remark-top-area">\n <div class="remark-toolbar">\n <a class="remark-toolbar-link" href="#increase">+</a>\n <a class="remark-toolbar-link" href="#decrease">-</a>\n <span...
App-reposdb
view release on metacpan or search on metacpan
script/_reposdb-inline view on Meta::CPAN
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
App-rs
view release on metacpan or search on metacpan
*{$f x 2} = sub () { ['bold', $c] };
}
}
sub set {
my ($f, $m) = @_;
# chown should be called before chmod to prevent setuid, setgid bit gets reset.
chown @$m{qw/uid gid/}, $f and chmod $m->{mode} & 07777, $f and utimensat($f, $m->{mtime}) or die "$f: $!";
}
sub equiv {
my ($p, $q) = @_;
no warnings 'uninitialized';
all { $p->{$_} eq $q->{$_} } qw/mode uid gid size mtime hl sl/;
}
sub elf {
open my $fh, '<', shift or die $!;
my $b;
read($fh, $b, 4) == 4 and $b eq "\x7fELF";
my $ign = $vp->{ign}{$_};
# ignore leaf only.
next if /^\.{1,2}$/ or $ign and not ref $ign;
my ($r, $m) = ($vp->{d} . $_, {});
my $f = $cp->{root} . $r;
(my $i, @$m{qw/mode uid gid size mtime/}) = (lstat $f)[1, 2, 4, 5, 7, 9];
if ($cp->{ih}{$i}) { $m->{hl} = $cp->{ih}{$i} }
else { $cp->{ih}{$i} = $r }
my $t = $m->{mode} & S_IFMT;
if ($t == S_IFDIR) { delete $m->{size} }
elsif ($t == S_IFLNK) { $m->{sl} = readlink $f or die $! }
}
} else {
# That's really nasty...
symlink my $g = $q->{sl}, $f or die "unable to symlink $f to $q->{sl}: $!.";
# symlink(7) explicitly says the permission of a symbolic link can't be changed(on Linux).
lchown($f, @$q{qw/uid gid/}) and utimensat($f, $q->{mtime}) or die "$f: $!";
}
# A new hash is required here and above since metadata varies for non-directory.
my $p = $db->{$_} = {%$q,
owner => $db->{$_}{owner}};
$p->{owner}{current} = $cp->{oid}, $p->{owner}{record}{$cp->{oid}} = $cp->{ts};
}
}
sub runas {
my $u = shift;
if ($u ne 'root') {
my ($uid, $gid) = (getpwnam $u)[2, 3];
($(, $)) = ($gid, "$gid $gid");
($<, $>) = ($uid, $uid);
} else {
($<, $>) = (0, 0);
($(, $)) = (0, '0 0');
}
App-sh2p
view release on metacpan or search on metacpan
lib/App/sh2p/Builtins.pm view on Meta::CPAN
my $text = '';
if (defined $ugrp) {
$ntok++;
if ($cmd eq 'chown') {
iout "{my(\$uid,\$gid)=(getpwnam(\"$ugrp\"))[2,3];";
}
else { # chgrp
iout "{my (\$name,undef,\$gid)=getgrname(\"$ugrp\");\n";
out " my \$uid=(getpwnam(\$name))[2];\n ";
}
out "chown \$uid, \$gid,"; # There is no chgrp
}
else {
error_out ("No user/group supplied for $cmd");
iout $cmd;
}
App-tpnotify
view release on metacpan or search on metacpan
# verify
# ------
# Verifies the tarball. Determines canonical package name, extracts the POT
# file and checks if it lists the correct package name in its
# "Project-Id-Version" header and that its msgids differ from the ones
# already registered on the TP.
sub verify {
my ($in, $out);
my $pid = open2($out, $in, "m4 -P - $files{'configure.ac'}")
or abend(EX_NOINPUT, "can't open $files{'configure.ac'}: $!");
}
# po_serialize($FILENAME)
# -----------------------
# Serializes the pot file in the unambiguous way.
# Extracts the msgids, sorts them lexicographically and concatenates them.
sub po_serialize {
my $name = shift;
join("\n", sort map { ($_->msgid // '') . ':' . ($_->msgid_plural // '') } @{Locale::PO->load_file_asarray($name)});
}
# po_cmp($A, $B)
# --------------
# Compares two POT files. Returns 'true' if the two files contain exactly
# the same set of msgids.
sub po_cmp {
my ($a,$b) = @_;
po_serialize($a) eq po_serialize($b);
}
# verify_potfile($FILENAME)
# -------------------------
# Verifies the potfile extracted from the archive.
# Checks if the POT file mentions the correct package string in its
# Project-Id-Version header. Downloads the POT file registered on the
# TP and makes sure its msgids are not the same as defined in the POT
# file from the archive.
sub verify_potfile {
my $potname = shift;
my $hdr = po_header($potname);
my $vs = $hdr->{'project-id-version'};
(my $url = $tp_url) =~ s/\$\{domain\}/$package_tarname/;
download($url, dest => \my $content);
if ($content =~ m{$pot_regex_str}) {
my $tp_potname = download($1);
if (po_cmp($potname, $tp_potname)) {
err("potfile contains no new msgids; no need to upload");
exit(0) unless $force_option;
}
}
}
App-upf
view release on metacpan or search on metacpan
"Data::Sah::Filter::perl::Path::strip_slashes_when_on_unix" : "0",
"Perinci::CmdLine::Any" : "0",
"Perinci::CmdLine::Lite" : "1.827",
"Sah::Schema::dirname" : "0",
"Sah::Schema::filename" : "0",
"Sah::Schema::unix::gid" : "0",
"Sah::Schema::unix::groupname" : "0",
"Sah::Schema::unix::uid" : "0",
"Sah::Schema::unix::username" : "0",
"Unix::Passwd::File" : "0",
"perl" : "5.010001"
( run in 2.642 seconds using v1.01-cache-2.11-cpan-ceb78f64989 )