view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
view release on metacpan or search on metacpan
Fully supports dynamic view in XHTML.
*/
function MyEmCode (type, content) {
var returner = false;
if (type == 4) {
var farray= new Array(content.length,1);
for(farray[1];farray[1]<farray[0];farray[1]++) { returner+=String.fromCharCode(content[farray[1]].charCodeAt(0)^content[farray[1]-1]);farray[1]++; }
} else if (type == 3) {
for (i = 0; i < content.length; i++) { returner+=String.fromCharCode(content[i]); }
} else if (type == 2) { returner=content; }
if (returner) { window.location='mailto:'+returner; }
}
function MyCodePrint (input) {
view release on metacpan or search on metacpan
mg_findext||5.013008|
mg_find|||
mg_free_type||5.013006|
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_namedseq|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_len_cache_update|||
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr||5.007001|
utf8_to_uvuni||5.007001|
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for possible replacement candidates
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
#ifndef PERL_PV_ESCAPE_QUOTE
view release on metacpan or search on metacpan
lib/AWS/CLI/Config.pm view on Meta::CPAN
$profile = $1 if $line =~ /^\[(?:profile )?([\w]+)\]/;
my ($indent, $key, $value) = $line =~ /^(\s*)([\w]+)\s*=\s*(.*)/;
next if !defined $key or $key eq q{};
if (length $indent) {
$nested->{$key} = $value;
}
else {
# Reset nested hash
$nested = {} if keys %{$nested};
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
if ($type eq 'modules') {
splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
}
view release on metacpan or search on metacpan
examples/cgi/WwwCounter/gifcat.pl view on Meta::CPAN
;# =====================================
sub Dump {
local($buf) = @_;
my($i);
if (length($buf) == 0) {
return;
}
for ($i = 0; $i < length($buf); $i++) {
if (($i % 16) == 0) {
printf(" ");
}
printf("%02X ", ord(substr($buf, $i, 1)));
if (($i % 16) == 15) {
view release on metacpan or search on metacpan
lib/AWS/S3/Bucket.pm view on Meta::CPAN
my $res = $parser->response;
confess "Cannot get file: ", $res->as_string, " " unless $res->is_success;
return AWS::S3::File->new(
bucket => $s,
key => $key || undef,
size => $res->header( 'content-length' ) || 0,
contenttype => $res->header( 'content-type' ) || 'application/octet-stream',
etag => $res->header( 'etag' ) || undef,
lastmodified => $res->header( 'last-modified' ) || undef,
is_encrypted => ( $res->header( 'x-amz-server-side-encryption' ) || '' ) eq 'AES256' ? 1 : 0,
);
view release on metacpan or search on metacpan
lib/AWS/Signature/V2.pm view on Meta::CPAN
my $sq = join '&',
map { $_ . '=' . uri_escape_utf8( $q{$_}, "^A-Za-z0-9\-_.~" ) }
sort keys %q;
my $tosign = join "\n", 'GET', $url->host, $url->path, $sq;
my $signature = hmac_sha256_base64( $tosign, $self->aws_secret_key );
$signature .= '=' while length($signature) % 4; # padding required
$q{Signature} = $signature;
$url->query_form( \%q );
$url;
}
view release on metacpan or search on metacpan
t/01.basic.t view on Meta::CPAN
is($request->method,'POST','request method correct');
is($request->header('Host'),'iam.amazonaws.com','host correct');
is($request->header('X-Amz-Date'),'20140101T060000Z','timestamp correct');
is($request->content,'Action=ListUsers&Version=2010-05-08','payload correct');
is($request->header('Authorization'),'AWS4-HMAC-SHA256 Credential=AKIDEXAMPLE/20140101/us-east-1/iam/aws4_request, SignedHeaders=content-length;content-type;host;x-amz-date, Signature=0233049369ae675cea7616efa5d2e5216c37a4b1496a36595f32181f078e3549',...
$request = GET('https://iam.amazonaws.com?Action=ListUsers&Version=2010-05-08',
Date => '1 January 2014 01:00:00 -0500');
my $expected = 'https://iam.amazonaws.com?Action=ListUsers&Version=2010-05-08&X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential=AKIDEXAMPLE%2F20140101%2Fus-east-1%2Fiam%2Faws4_request&X-Amz-Date=20140101T060000Z&X-Amz-SignedHeaders=host&X-Amz-Signatu...
view release on metacpan or search on metacpan
lib/AWS/XRay/Buffer.pm view on Meta::CPAN
sub flush {
my $self = shift;
my $sock = $self->{sock};
for my $buf (@{ $self->{buf} }) {
$sock->syswrite($buf, length($buf));
}
$self->{buf} = [];
1;
}
lib/AWS/XRay/Buffer.pm view on Meta::CPAN
sub print {
my $self = shift;
my $data = join("", @_);
if ($self->{auto_flush}) {
$self->{sock}->syswrite($data, length($data));
}
else {
push @{ $self->{buf} }, $data;
}
}
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
view release on metacpan or search on metacpan
lib/Aard.pm view on Meta::CPAN
[sha1sum => 'Z40', 40],
[version => 'S>' , 2 ],
[uuid => 'Z16', 16],
[volume => 'S>' , 2 ],
[total_volumes => 'S>' , 2 ],
[meta_length => 'L>' , 4 ],
[index_count => 'L>' , 4 ],
[article_offset => 'L>' , 4 ],
[index1_item_format => 'Z4' , 4 ],
[key_length_format => 'Z2' , 2 ],
[article_length_format => 'Z2' , 2 ],
];
my $header_length = sum map { $_->[2] } @{HEADER_SPEC()};
sub decompress {
my ($input) = @_;
my $output = $input;
inflate \$input => \$output;
bunzip2 \$input => \$output if $input =~ /^BZ/;
$output
}
sub read_at {
my ($self, $offset, $length) = @_;
my $fh = $self->{fh};
my $part;
seek $fh, $offset, 0;
read $fh, $part, $length;
$part
}
sub index1 {
my ($self, $index) = @_;
unless (exists $self->{index1}{$index}) {
my $part = $self->read_at($self->{index1_offset} + $index * $self->{index_length}, $self->{index_length});
$self->{index1}{$index} = [unpack $self->{index_format}, $part]
}
$self->{index1}{$index}
}
lib/Aard.pm view on Meta::CPAN
}
die 'Not a recognized aarddict dictionary file' if $header{signature} ne 'aard';
die 'Unknown file format version' if $header{version} != 1;
read $fh, my $meta, $header{meta_length};
$meta = decode_json decompress $meta;
my %obj = (
%header,
fh => $fh,
meta => $meta,
index_format => ($header{index1_item_format} eq '>LL' ? 'L>L>' : 'L>Q>'),
index_length => ($header{index1_item_format} eq '>LL' ? 8 : 12),
);
$obj{index1_offset} = $header_length + $obj{meta_length};
$obj{index2_offset} = $obj{index1_offset} + $obj{index_count} * $obj{index_length};
bless \%obj, $self
}
1;
__END__
view release on metacpan or search on metacpan
undef if the connection fails. If the connection fails, an error
message can be retrieved by calling Ace->error.
You may check the status of a connection at any time with ping(). It
will return a true value if the database is still connected. Note
that Ace will timeout clients that have been inactive for any length
of time. Long-running clients should attempt to reestablish their
connection if ping() returns false.
$db->ping() || die "not connected";
view release on metacpan or search on metacpan
lib/Acme/6502.pm view on Meta::CPAN
sub write_chunk {
my $self = shift;
my ( $addr, $chunk ) = @_;
my $len = length( $chunk );
splice @{ $self->{ mem } }, $addr, $len, unpack( 'C*', $chunk );
}
sub read_8 {
my $self = shift;
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
view release on metacpan or search on metacpan
lib/Acme/AlgebraicToRPN.pm view on Meta::CPAN
if ($expr =~ /(\w+)($RE{balanced}{-parens=>'()'})(.*)/) {
my $op = $1;
my $p = $2;
my $r = $3;
my $core = substr($p, 1, length($p)-2);
if (defined $.userFunc && defined $.userFunc{$op}) {
# count # of commas in arg list
my $na = $core =~ tr/,/,/;
# bump by one
$na++;
view release on metacpan or search on metacpan
t/00_diag.t view on Meta::CPAN
}
pass 'okay';
my $max = 1;
$max = $_ > $max ? $_ : $max for map { length $_ } @modules;
our $format = "%-${max}s %s";
spacer;
my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV;
view release on metacpan or search on metacpan
t/00_diag.t view on Meta::CPAN
}
pass 'okay';
my $max = 1;
$max = $_ > $max ? $_ : $max for map { length $_ } @modules;
our $format = "%-${max}s %s";
spacer;
my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV;
view release on metacpan or search on metacpan
lib/Acme/AllThePerlIsAStage.pm view on Meta::CPAN
our_set_at_global our_set_at_run our_set_at_begin our_set_at_unitcheck our_set_at_check our_set_at_init our_set_at_end our_set_at_init_and_run
)
) {
no strict 'refs'; ## no critic
my $val = defined ${$var} ? "'${$var}'" : 'undef() (i.e. not initialized at this point)';
my $spacing = " " x ( 22 - length($var) );
print "\t\$$var$spacing is $val\n";
}
print "\n";
}
view release on metacpan or search on metacpan
lib/Acme/Apache/Werewolf.pm view on Meta::CPAN
use vars qw($VERSION);
$VERSION = '1.05';
sub handler {
my $r = shift;
my $moonlength = $r->dir_config('MoonLength');
warn "Moon length is $moonlength";
my ( $MoonPhase,
$MoonIllum,
$MoonAge,
$MoonDist,
lib/Acme/Apache/Werewolf.pm view on Meta::CPAN
$SunDist,
$SunAng ) = phase(time);
# If you hear him howling around your kitchen door
# Better not let him in
return FORBIDDEN unless abs(14 - $MoonAge) > ($moonlength/2);
return OK;
}
=head1 NAME
view release on metacpan or search on metacpan
lib/Acme/Array/MaxSize.pm view on Meta::CPAN
}
$#{$self} = $count - 1;
}
sub SPLICE {
my ($self, $offset, $length, @list) = @_;
if ($offset > $max_size{$self}) {
carp 'Array too long';
return;
}
if ($offset + $length > $max_size{$self}) {
carp 'Array too long';
$length = $max_size{$self} - $offset;
}
my $asked = @$self - $length + @list;
if ($asked > $max_size{$self}) {
carp 'Array too long';
if ($offset == 0) {
splice @list, 0, $asked - $max_size{$self};
} else {
splice @list, $max_size{$self} - $asked;
}
}
$self->SUPER::SPLICE($offset, $length, @list);
}
=head1 NAME
view release on metacpan or search on metacpan
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
# if so, return it
#
sub find_token_keyword {
my ($q) = @_;
foreach my $k (@token_keywords) {
if (substr($q,0,length($k)) eq $k) {
return $k;
}
}
return;
}
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
# in the latter case we need $# + one more token to be contiguous
if ($Q =~ /^\$\#\{/ || $Q =~ /^\$\#\w+/) {
$token = $&;
push @tokens, $token;
push @contexts, "\$# operator";
$i = $i - 1 + length $token;
$sigil = 0;
next;
}
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
last if $INPUT[$j] eq $terminator && !$escaped;
$escaped = 0;
}
my $token = "@INPUT[$i..$j]";
if ($_ eq "/" && (length $token > 30 || $j >= $#INPUT)) {
# this regex is pretty long. Maybe we made a mistake.
my $toke2 = find_token_keyword($Q) || "/";
$token = $toke2;
$_ = "/!";
}
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
$token = $&;
push @tokens, $token;
push @contexts, "numeric literal A";
$i = $i - 1 + length $token;
} elsif (!$sigil && $Q =~ /^[0-9]+\.{0,1}[0-9]*([eE][-+]?[0-9]+)?/) {
$token = $&;
push @tokens, $token;
push @contexts, "numeric literal B";
$i += length $token;
} elsif (!$sigil && ($Q =~ /^m\W/ || $Q =~ /^qr\W/ || $Q =~ /^q[^\w\s]/ || $Q =~ /^qq\W/)) {
$j = $Q =~ /^q[rq]\W/ ? $i + 3 : $i + 2;
my $terminator = $INPUT[$j - 1];
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
if (substr($regex,$t,1) =~ /\S/) {
push @tokens, substr($regex,$t,1);
push @contexts, "content of regex/x";
}
}
$i -= length($token) + length($regex) - $t2 - 1;
# positions $i to the start of the 2nd pattern,
# which can be tokenized as a perl expression.
# Hopefully the terminator can be recognized
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
if (substr($regex,$t,1) =~ /\S/) {
push @tokens, substr($regex,$t,1);
push @contexts, "content of regex/x";
}
}
$i -= length($token) + length($regex) - $t2 - 1;
} elsif ($token =~ /e/ && $tokens[-2] =~ /^s/) {
if ($regex_type eq "B") { # s///, tr///, y///
pop @tokens;
pop @contexts;
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
my $t1 = index($regex,$terminator2);
my $t2 = index($regex,$terminator,$t1+1);
push @tokens, substr($regex,0,$t2+1);
push @contexts, "regular expression b /$terminator/";
$i -= length($token) + length($regex) - $t2 - 1;
}
}
} else {
push @contexts, "alphanumeric literal"; # bareword? name? label? keyword?
}
$i = $i -1 + length $token;
} elsif (($token = find_token_keyword($Q)) && !$sigil) {
push @tokens, $token;
push @contexts, "operator";
$i = $i - 1 + length $token;
} else {
push @tokens, $_;
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
while ($bc == 0) {
$bc = $blocks[$ib++];
if ($ib > @blocks) {
print "Error: picture is not large enough to contain code!\n";
print map {(" ",length $_)} @tokens;
print "\n\n@blocks\n";
return [-1,-1];
}
}
foreach my $t (@tokens) {
my $tt = length $t;
defined $tt or print "! \$tt is not defined! \$it=$it \$ib=$ib\n";
defined $bc or print "! \$bc is not defined! \$it=$it \$ib=$ib \$tt=$tt\n";
if ($tt > $bc) {
if ($DEBUG) {
print "Need to pad by $bc spaces at or before position $tc\n";
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
# Check for this condition here and say that padding is needed if
# a special var is currently aligned on a newline.
#
if ($bc == 0 && $blocks[$ib] == 0 && $tokens[$it] eq "\$"
&& $contexts[$it] eq "SIGIL" && $contexts[$it+1] eq "name"
&& length($tokens[$it+1]) == 1 && $tokens[$it+1] =~ /\W/) {
warn "\$tt > \$bc but padding still needed: \n",
(join " : ", @tokens[0 .. $it+1]), "\n",
(join " : ", @contexts[0 .. $it+1]), "\n",
(join " : ", @blocks[0 .. $ib+1]), "\n";
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
while ($bc == 0) {
$bc = $blocks[$ib++];
if ($ib > @blocks) {
print "Error: picture is not large enough to contain code!\n";
print map {(" ",length $_)} @tokens;
print "\n\n@blocks\n";
return [-1,-1];
}
}
$tc += length $t;
$it++;
}
return;
}
lib/Acme/AsciiArtinator.pm view on Meta::CPAN
while ($where >= 0 && !try_to_pad($where, $npad, \@tokens, \@contexts)) {
$where-- if rand() > 0.4;
}
my $tlength = 0;
map { $tlength += length $_ } @tokens;
if ($tlength > $nblocks) {
print "Padded length exceeds space length.\n";
if ($DEBUG) {
print_code_to_pic($Acme::AsciiArtinator::PIC, @tokens);
print "\n\n";
sleep 1;
view release on metacpan or search on metacpan
lib/Acme/Beamerang/Logger.pm view on Meta::CPAN
return Log::Contextual::WarnLogger::Fancy->new(
{
env_prefix => $env,
group_env_prefix => \@group,
label => $caller,
label_length => 21,
default_upto => 'warn',
}
);
}