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
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
view release on metacpan or search on metacpan
bin/org-daemon view on Meta::CPAN
sub check_for_updates {
my $changes = 0;
for my $org_file (keys %org_files) {
my $org_data = $org_files{$org_file};
my($modtime) = (stat($org_file))[9];
if (!defined $modtime) {
# non-existing file
$org_data->{modified} = $modtime;
$org_data->{dates} = [];
open_warning($org_file);
view release on metacpan or search on metacpan
lib/App/Perlbrew/Util.pm view on Meta::CPAN
sub files_are_the_same {
## Check dev and inode num. Not useful on Win32.
## The for loop should always return false on Win32, as a result.
my @files = @_;
my @stats = map {[ stat($_) ]} @files;
my $stats0 = join " ", @{$stats[0]}[0,1];
for (@stats) {
return 0 if ((! defined($_->[1])) || $_->[1] == 0);
unless ($stats0 eq join(" ", $_->[0], $_->[1])) {
view release on metacpan or search on metacpan
lib/App/perlmv/scriptlet/add_prefix_datestamp.pm view on Meta::CPAN
my $re = $ARGS->{prefix_regex} // qr/\A[12][0-9]{3}(0[1-9]|10|11|12)([0-2][0-9]|30|31)-/;
if ($ARGS->{avoid_duplicate_prefix} && $_ =~ $re) {
return $_;
}
my @stat = stat($_);
my $time = defined $ARGS->{date} ? main::_parse_date($ARGS->{date}) : $stat[9];
my $format = $ARGS->{prefix_format} // ($ARGS->{with_time} ? '%Y%m%dT%H%M%S-' : '%Y%m%d-');
my $prefix = POSIX::strftime($format, localtime($time));
"$prefix$_";
view release on metacpan or search on metacpan
require "$Bin/testlib.pl";
prepare_for_testing();
test_perlmv([1, 2, 3], {code=>'$_++', mode=>'l'}, ["1", "2", "2.1", "3", "3.1", "4"], 'normal');
# XXX actually test that an extra link is created, via stat()
end_testing();
view release on metacpan or search on metacpan
lib/App/Phoebe.pm view on Meta::CPAN
my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift);
return sprintf('%02d:%02d UTC', $hour, $min);
}
sub modified {
my $ts = (stat(shift))[9];
return $ts;
}
sub serve_history {
my $stream = shift;
view release on metacpan or search on metacpan
bin/plx-packed view on Meta::CPAN
$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
use strict;use warnings;package File::pushd;our$VERSION='1.009';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub...
FILE_PUSHD
$fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY';
package HTTP::Tiny;use strict;use warnings;our$VERSION='0.056';use Carp ();my@attributes;BEGIN {@attributes=qw(cookie_jar default_headers http_proxy https_proxy keep_alive local_address max_redirect max_size proxy no_proxy timeout SSL_options ver...
sub $sub_name {
my (\$self, \$url, \$args) = \@_;
\@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
return \$self->request('$req_method', \$url, \$args || {});
view release on metacpan or search on metacpan
script/_ppgrep view on Meta::CPAN
# my $filter;
# if ($args{filter} && !ref($args{filter})) {
# my @seqs = split /\s*\|\s*/, $args{filter};
# $filter = sub {
# my $name = shift;
# my @st = stat($name) or return 0;
# my $mode = $st[2];
# my $pass;
# SEQ:
# for my $seq (@seqs) {
# my $neg = sub { $_[0] };
script/_ppgrep view on Meta::CPAN
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
# map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
# $value->{tell} = tell(*{$_[0]});
# }
# }
# $ynode->{$type} = $value;
# }
view release on metacpan or search on metacpan
t/00-sane.t view on Meta::CPAN
}
sub devino {
my ($fn) = @_;
my @s = stat($fn);
return @s ? "$s[0]:$s[1]" : "$fn absent";
}
main();
view release on metacpan or search on metacpan
inc/Devel/CheckOS.pm view on Meta::CPAN
sub list_platforms {
# sort by mtime, so oldest last. This was necessary so that if a module
# appears twice in @INC we pick the newer one but that functionality is
# no longer needed. We do need to de-dupe the list though
my @modules = sort {
(stat($a->{file}))[9] <=> (stat($b->{file}))[9]
} grep {
$_->{module} !~ $re_Alias
} map {
my (undef, $dir_part, $file_part) = File::Spec->splitpath($_);
$file_part =~ s/\.pm$//;
view release on metacpan or search on metacpan
lib/App/reposdb.pm view on Meta::CPAN
extra data. They have various uses, but my first use-case for this is to store
last commit/status/pull time (updated via a post-commit git hook or `gitwrap`).
This is useful to speed up like syncing of repositories in `Git::Bunch` that
wants to find out which of the hundreds/thousand+ git repositories are "the most
recently used" to prioritize these repositories first. Using information from
`repos.db` is faster than having to `git status` or even stat() each repository.
_
};
sub _complete_repo {
lib/App/reposdb.pm view on Meta::CPAN
extra data. They have various uses, but my first use-case for this is to store
last commit/status/pull time (updated via a post-commit git hook or C<gitwrap>).
This is useful to speed up like syncing of repositories in C<Git::Bunch> that
wants to find out which of the hundreds/thousand+ git repositories are "the most
recently used" to prioritize these repositories first. Using information from
C<repos.db> is faster than having to C<git status> or even stat() each repository.
=head1 FUNCTIONS
=head2 add_repo_tag
view release on metacpan or search on metacpan
lib/App/rimetadb.pm view on Meta::CPAN
log_debug("Processing package $pkg ...");
#sleep 1;
my $rec = $dbh->selectrow_hashref("SELECT * FROM package WHERE name=?",
{}, $pkg);
my $mp = Module::Path::More::module_path(module=>$pkg);
my @st; @st = stat($mp) if $mp;
unless ($args{force} || !$rec || !$rec->{mtime} || !@st || $rec->{mtime} < $st[9]) {
log_debug("$pkg ($mp) hasn't changed since last recorded, skipped");
next;
}
view release on metacpan or search on metacpan
void *mmapr(const char *f, off_t *l)
{
int fd;
errn1(fd = open(f, O_RDONLY));
struct stat b;
errn1(fstat(fd, &b));
if (l) *l = b.st_size;
void *p = NULL;
if (b.st_size)
errn1((long int)(p = mmap(0, b.st_size, PROT_READ, MAP_PRIVATE, fd, 0)));
errn1(close(fd));
view release on metacpan or search on metacpan
script/newest-mtime view on Meta::CPAN
use Getopt::Long;
sub find_newest_mtime {
my $path = shift;
my @st = lstat($path) or return (0, $path);
my $is_dir = (-d _);
my $mtime = $st[9];
if ($is_dir) {
opendir my($dh), $path or do {
warn "newest-mtime: Can't opendir $path: $!, skipped\n";
view release on metacpan or search on metacpan
#sysread $FH , my $s1 , 2 * $LEN ;
#my $s2 = substr $s1 , $LEN , $LEN , '' ;
#$flg = 0 unless $s1 =~ m/^\Q$H\E.*:.*\n$/ && $s2 =~ m/^\Q$H\E.*:.*\n$/ ;
#$flg ? sysseek $FH , -$LEN , 1 : sysseek $FH , 0, 2 ;
#my $fp = (stat($FH))[2] ; say $fp ;chmod 000, $FH ; $FH->flush ;
print $FH "$DTSTR\n" ; # flock $FH , LOCK_UN ;
#$FH->flush ;chmod $fp, $FH ;
#sleep 5 ;
close $FH ;
view release on metacpan or search on metacpan
lib/App/todoist.pm view on Meta::CPAN
$config->define('priority', { ARGCOUNT => 1, ALIAS => 'p', DEFAULT => 4 });
$config->define('add-project', { ARGCOUNT => 1, ALIAS => 'ap' });
if (defined($ENV{HOME}) && -f "$ENV{HOME}/.todoist") {
my $filename = "$ENV{HOME}/.todoist";
if (((stat($filename))[2] & 36) != 0) {
croak "your config file ($filename) is readable by others!\n";
}
$config->file($filename) || exit 1;
}
view release on metacpan or search on metacpan
lib/App/wmiirc/Ssh.pm view on Meta::CPAN
my($self, @args) = @_;
state($last_mtime, @hosts);
my $known_hosts = "$ENV{HOME}/.ssh/known_hosts";
if(-r $known_hosts && !$last_mtime
|| $last_mtime != stat($known_hosts)->mtime) {
open my $fh, "<", $known_hosts or die "$known_hosts: $!";
@hosts = map /^([^, ]+)/ ? $1 : (), <$fh>;
}
if(my $host = @args ? "@args"
view release on metacpan or search on metacpan
script/_wordlist-blossom view on Meta::CPAN
# my $filter;
# if ($args{filter} && !ref($args{filter})) {
# my @seqs = split /\s*\|\s*/, $args{filter};
# $filter = sub {
# my $name = shift;
# my @st = stat($name) or return 0;
# my $mode = $st[2];
# my $pass;
# SEQ:
# for my $seq (@seqs) {
# my $neg = sub { $_[0] };
view release on metacpan or search on metacpan
script/_wordlist-wordle view on Meta::CPAN
# my $filter;
# if ($args{filter} && !ref($args{filter})) {
# my @seqs = split /\s*\|\s*/, $args{filter};
# $filter = sub {
# my $name = shift;
# my @st = stat($name) or return 0;
# my $mode = $st[2];
# my $pass;
# SEQ:
# for my $seq (@seqs) {
# my $neg = sub { $_[0] };
view release on metacpan or search on metacpan
script/_wordlist view on Meta::CPAN
# my $filter;
# if ($args{filter} && !ref($args{filter})) {
# my @seqs = split /\s*\|\s*/, $args{filter};
# $filter = sub {
# my $name = shift;
# my @st = stat($name) or return 0;
# my $mode = $st[2];
# my $pass;
# SEQ:
# for my $seq (@seqs) {
# my $neg = sub { $_[0] };
view release on metacpan or search on metacpan
lib/App/wordstat.pm view on Meta::CPAN
=head2 wordstat
Usage:
wordstat(%args) -> [status, msg, payload, meta]
Return word statistics of a text.
Examples:
=over
=item * Example #1:
wordstat(text => "An optimistic person sees good things everywhere, is generally confident and\nhopeful of what the future holds. From the optimist's point-of-view the world is\nfull of potential opportunities. The pessimist, on the other hand, obse...
Result:
[
200,
lib/App/wordstat.pm view on Meta::CPAN
},
]
=item * Supply text from file or stdin:
wordstat( text => "file.txt");
=back
This function is not exported.
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
view release on metacpan or search on metacpan
return $ret;
}
sub load_zen_file
{
my $filename = shift;
my $st = stat($filename);
my $mtime = $st->mtime;
my $filesize = $st->size;
open(my $fh, '<:encoding(UTF-8)', $filename)
or die "Could not open file '$filename' $!";
# Should return the data since last fetch offset.
sub on_append_file {
my ($cgi, $path) = @_;
my $data = $cgi->param('POSTDATA');
append_to_file($path, $data);
my @stat_info = stat($path);
if (@stat_info) {
# Extract the last modification time
my $mtime = $stat_info[9];
print "HTTP/1.0 200 OK\r\n";
print "Last-Modified: $mtime\r\n";
my $n = $cgi->url_param('n') || 0;
my $last_mtime = $cgi->url_param('last_modified');
if (-f $path) {
# override require last_mtime
my $stat = stat($path);
my $mtime = $stat->mtime;
if (!$last_mtime) {
write_error(409, "Conflict", "Missing query parameter 'last_modified' l=$l");
print Dumper $cgi;
return;
write_file($path, $x.$data.$y);
} else {
print "HTTP/1.0 400 Bad request\r\n";
return;
}
my $mtime = stat($path)->mtime;
if ($mtime) {
print "HTTP/1.0 200 OK\r\n";
print "Last-Modified: $mtime\r\n";
print "Content-Length: 0\r\n\r\n";
} else {
while (<FH>) {
print $_;
}
close FH;
} elsif ($raw eq '1' && $l > 0) {
my $mtime = stat($path)->mtime;
print "HTTP/1.0 200 OK\r\n";
print "Last-Modified: $mtime\r\n";
print "Content-Type: text/plain\r\n\r\n";
open my $fh, '<', $path or die "Can not open file: $!";
while (<$fh>) {
close $fh;
} else {
my ($ext) = $path =~ /\.([^.]+)$/;
my $mime_type = $mimeTypes{lc($ext)} || 'application/octet-stream';
open my $fh, '<:raw', $path or die "Cannot open file: $!";
my $mtime = stat($path)->mtime;
my $filesize = -s $path;
print "HTTP/1.1 200 OK\r\n";
print "Content-Type: $mime_type\r\n";
print "Last-Modified: $mtime\r\n";
print "Content-Length: $filesize\r\n";
opendir(my $dh, $path) or die "Cannot open directory: $!";
while (my $file = readdir $dh) {
next if $file =~ /^\./;
next if $file =~ /~$/;
my $filepath = "$path/$file";
my $mtime = stat($filepath)->mtime;
push @contents, {
name => -d $filepath ? "$file/" : $file,
size => -s "$path/$file",
mtime => $mtime,
};
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
view release on metacpan or search on metacpan
lib/Arabic.pm view on Meta::CPAN
# Filter >>>
# Source >
# Escape >>>>> executable without re-escape
#----------------------------------------------------
my $mtime_filter = (stat(__FILE__ ))[9];
my $mtime_source = (stat($filename ))[9];
my $mtime_escape = (stat("$filename.e"))[9];
if (($mtime_escape < $mtime_source) or ($mtime_escape < $mtime_filter)) {
unlink "$filename.e";
}
}
}
lib/Arabic.pm view on Meta::CPAN
seek($fh, 0, 0) or die __FILE__, ": Can't seek file: $filename.e\n";
my $e_script = Arabic::escape_script($filename);
print {$fh} $e_script;
my $mode = (stat($filename))[2] & 0777;
chmod $mode, "$filename.e";
close($fh) or die "Can't close file: $filename.e: $!";
}
view release on metacpan or search on metacpan
perllib/Arch/Inventory.pm view on Meta::CPAN
sub annotate_fs ($;$) {
my $self = shift;
if (@_) {
$_[0]->{stat} = [ lstat("$self->{directory}/$_[0]->{path}") ];
$_[0]->{symlink} = readlink("$self->{directory}/$_[0]->{path}")
if $_[0]->{type} eq SYMLINK;
} else {
$self->foreach(sub { $self->annotate_fs($_[0]) });
}
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }