view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join(" ", grep length, $clean->{FILES}, @_),
);
}
sub libs {
my $self = shift;
view release on metacpan or search on metacpan
lib/Acme/Nyaa.pm view on Meta::CPAN
return $self->{'language'} if $lang eq $self->{'language'};
return $self->{'language'} unless $lang =~ m/\A[a-zA-Z]{2}\z/;
my $nekoobject = undef;
my $referclass = $self->loadmodule( $lang );
return $self->{'language'} unless length $referclass;
return $self->{'language'} if $referclass eq $self->subclass;
$nekoobject = $self->findobject( $referclass, 1 );
return $self->{'language'} unless ref $nekoobject eq $referclass;
lib/Acme/Nyaa.pm view on Meta::CPAN
my $list = $self->{'loaded-languages'};
my $referclass = __PACKAGE__.'::'.ucfirst( lc $lang );
my $alterclass = __PACKAGE__.'::'.ucfirst( $Default );
return q() unless length $lang;
return $referclass if( grep { lc $lang eq $_ } @$list );
eval {
Module::Load::load $referclass;
push @$list, lc $lang;
lib/Acme/Nyaa.pm view on Meta::CPAN
my $name = shift;
my $new1 = shift || 0;
my $this = undef;
my $objs = $self->{'objects'} || [];
return unless length $name;
for my $e ( @$objs ) {
next unless ref($e) eq $name;
$this = $e;
lib/Acme/Nyaa.pm view on Meta::CPAN
my $self = shift;
my $argv = shift;
my $text = undef;
$text = ref $argv ? $$argv : $argv;
return $text unless length $text;
$self->reckon( \$text );
return $text if $self->{'utf8flag'};
return $text unless $self->{'encoding'};
lib/Acme/Nyaa.pm view on Meta::CPAN
my $argv = shift;
my $text = undef;
$text = ref $argv ? $$argv : $argv;
return $text unless $self->{'encoding'};
return $text unless length $text;
$text = Encode::encode_utf8 $text if utf8::is_utf8 $text;
if( $self->{'encoding'} ne 'utf8' ) {
Encode::from_to( $text, 'utf8', $self->{'encoding'} );
}
view release on metacpan or search on metacpan
lib/Acme/Ook.pm view on Meta::CPAN
# Coalesce sequences of increments or decrements
my $prog = $_[1];
# print "Before '$prog'\n";
foreach my $thing ('$Ook', '$Ook[$Ook]') {
foreach my $op ('+', '-') {
my $left = length "$thing$op$op;";
$prog =~ s{((?:\Q$thing$op$op\E;){2,})}
{"$thing$op=".(length ($1)/$left).';'}ges;
}
}
# print "After '$prog'\n";
return $prog;
}
lib/Acme/Ook.pm view on Meta::CPAN
}
sub compile {
my $self = shift;
my $prog;
$prog .= $self->_compile($$self, "(new)", 0) if defined $$self && length $$self;
if (@_) {
local *OOK;
while (@_) {
my $code = shift;
if (ref $code eq 'IO::Handle') {
view release on metacpan or search on metacpan
example/pearl view on Meta::CPAN
my @parts = split(/\n/, $now);
my ($maxy, $maxx) = `stty size` =~ /(\d+) (\d+)/;
for (my $y = 0;$y < $maxy;$y++) {
for (my $x = 0;$x < $maxx - 24;$x += 24) {
my $line = $parts[($y % scalar(@parts))];
$out .= $line . ' 'x(24 - length(encode('euc-jp', $line)));
}
$out .= "\n";
}
print $out;
}
view release on metacpan or search on metacpan
lib/Acme/PETEK/Testkit/modperl1.pm view on Meta::CPAN
return <<HTML;
<html><head><title>Counter: $value</title></head>
<body><form method="post"><input type="hidden" name="cur" value="$value">
<div align="center">
<p><big>Current Value: <u>$value</u></big></p>
<p><input type="text" name="decrval" value="1" size="3" maxlength="3"
/><input type="submit" name="decrn" value="<<"
/><input type="submit" name="decr1" value="<"
/><input type="submit" name="reset" value="-0-"
/><input type="submit" name="incr1" value=">"
/><input type="submit" name="incrn" value=">>"
/><input type="text" name="incrval" value="1" size="3" maxlength="3"
/></p>
</div>
</body></html>
HTML
}
view release on metacpan or search on metacpan
}
if( ! $self->{"cfg"}->{"client"} ) {
$self->{"cfg"}->{"client"} = uc($ENV{"hostname"}) || sprintf("%s-%0.5i", "Acme-PIA-Export", rand(99999));
}
my $requestbody = "$self->{cfg}->{username}~;~$self->{cfg}->{password}~;~$self->{cfg}->{client}~;~$scopes{$what};~export~;~O~;~~#~";
my $content_length = length($requestbody);
my $request = "POST $query_url HTTP/1.1\n" .
"Pragma: no-cache\n" .
"Host: www.arcor.de\n" .
"Accept-Ranges: bytes\n" .
"Content-Type: text/html\n" .
"Content-Length: $content_length\n" .
"\n" .
$requestbody;
if( $self->{"cfg"}->{"DEBUG"} ) {
print "Sending request:$/$request$/-------------------------------$/";
}
view release on metacpan or search on metacpan
lib/Acme/PM/Barcelona/12x5_ca.pod view on Meta::CPAN
=for latex \scriptsize
$_=q;Barcelona Perl Mongers;,$/=y,gaudi,,,;map$,+=(split//)*(-1)**$|++
,(split)[.11_09,1.714];$.=''!~m~erce~;$"=y,catalunya,,,$;=y,rambles,,,
$*=$/^$.;$:=$.+length,$@=$***$**$/**$*%$:,$%=$/*$"-$*;print+chr($_<0xA
?$.."$[$_":m:^$.:?$..$_:$_)for($**$**$/*$",$"*$@+$**$/,$**$,,$***$,,$/
*$,,$;,$***$/,$,*$/,$.<<$,,$%-$*,$"+$/,$***$,,(($,*$*)**$*)-$/,$***$/,
$@+$/,$:-($/**$*),$.,$:+$"+$*,$.<<$*,$,**$/-$:-$,,exp$:/$,,$",$.,$"*$*
,$***$,,log$.,$.,-$/+$"*$,,$/+$"*$;,$.,++$@,$***($/&=$/+Barcelona_pm))
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
my $cwd = Cwd::cwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
view release on metacpan or search on metacpan
lib/Acme/Padre/PlayCode.pm view on Meta::CPAN
my $doc = $main->current->document;
return unless $doc;
my $src = $main->current->text;
my $code = $src ? $src : $doc->text_get;
return unless ( defined $code and length($code) );
require Acme::PlayCode;
my $playapp = new Acme::PlayCode;
$playapp->load_plugin( $plugin );
view release on metacpan or search on metacpan
lib/Acme/Palindrome.pm view on Meta::CPAN
open 0, ">$0" or print "Cannot reverse '$0'\n" and exit;
print {0} "use Acme::Palindrome;\n", backward $code and exit;
sub palindrome {
my $max = 0;
length > $max && ( $max = length ) for @_;
return join "\n",
map sprintf( "%${max}s", scalar reverse $_ ),
reverse @_;
}
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/AutoInstall.pm view on Meta::CPAN
my $cwd = Cwd::cwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
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/Makefile.pm view on Meta::CPAN
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join(' ', grep length, $clean->{FILES}, @_),
);
}
sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
%$realclean,
FILES => join(' ', grep length, $realclean->{FILES}, @_),
);
}
sub libs {
my $self = shift;
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join(" ", grep length, $clean->{FILES}, @_),
);
}
sub libs {
my $self = shift;
view release on metacpan or search on metacpan
lib/Acme/Phlegethoth.pm view on Meta::CPAN
((rand() < 0.25) ? $pre[rand @pre] : "") .
$word[rand @word] .
((rand() < 0.25) ? $suf[rand @suf] : "") .
((rand() < 0.1) ? "! " : "") .
" "
) unless length $chant;
$prayer .= $1, redo if $chant =~ s/([^a-z])$//;
$prayer .= chop $chant;
substr($prayer, -1, 1) =~ tr[a-z][A-Z] if $tentacle;
}
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
my $cwd = Cwd::cwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
view release on metacpan or search on metacpan
inc/MyBumpVersionAfterRelease.pm view on Meta::CPAN
use utf8;
use Path::Tiny 0.061;
# this is a smarter version of:
# [Run::AfterRelease]
# run = %x -p -i -e's/^version = 3\.(\d+)\s/sprintf(q(version = %0.( . (length($1)+1) . q(g), atan2(1,1)*4)/x'
sub after_release
{
my $self = shift;
# edits dist.ini to add one decimal point to the version
my $Ï€ = atan2(1,1) * 4;
my $original_version = $self->zilla->version;
my $length = length($original_version);
# add another digit if we added a 0, as it will be numerically identical
do {} while substr($Ï€, $length++, 1) eq '0';
my $new_version = substr($Ï€, 0, $length);
# munge dist.ini to edit version line
my $path = path('dist.ini');
my $content = $path->slurp_utf8;
my $delta_length = $length - length($original_version);
if ($content =~ s/^(version = )$original_version\s{$delta_length}(\s+)/$1$new_version$2/m)
{
# append+truncate to preserve file mode
$path->append_utf8({ truncate => 1 }, $content);
return 1;
}
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/Plack/Middleware/Acme/Werewolf.pm view on Meta::CPAN
=head1 SYNOPSIS
my $app = sub { ... };
builder {
enable "Acme::Werewolf", moonlength => 4;
$app;
};
=head1 DESCRIPTION
view release on metacpan or search on metacpan
lib/Tupelo/Munge.pm view on Meta::CPAN
$tuple = pure_tuple(\$s, \@a, \%h, \&c);
$tuple = constant_tuple(\$s, \@a, \%h, \&c);
$tuple = variable_tuple(\$s, \@a, \%h, \&c);
use Tuple::Munge
qw(tuple_mutable tuple_length tuple_slot tuple_slots);
if(tuple_mutable($tuple)) { ...
$len = tuple_length($tuple);
$ref = tuple_slot($tuple, 3);
@refs = tuple_slots($tuple);
use Tuple::Munge qw(tuple_set_slot tuple_set_slots tuple_seal);
lib/Tupelo/Munge.pm view on Meta::CPAN
our $VERSION = "0.000";
use parent "Exporter";
our @EXPORT_OK = qw(
pure_tuple constant_tuple variable_tuple
tuple_mutable tuple_length tuple_slot tuple_slots
tuple_set_slot tuple_set_slots tuple_seal
);
XSLoader::load(__PACKAGE__, $VERSION);
lib/Tupelo/Munge.pm view on Meta::CPAN
=item tuple_mutable(TUPLE)
I<TUPLE> must be a reference to a tuple. Returns a truth value indicating
whether the tuple is mutable.
=item tuple_length(TUPLE)
I<TUPLE> must be a reference to a tuple. Returns the number of slots
that the tuple currently has.
=item tuple_slot(TUPLE, INDEX)
view release on metacpan or search on metacpan
lib/Acme/ppport.h view on Meta::CPAN
mg_findext|5.013008||pn
mg_find|||n
mg_free_type||5.013006|
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||n
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|n
lib/Acme/ppport.h view on Meta::CPAN
reg_named_buff_nextkey||5.009005|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||n
lib/Acme/ppport.h view on Meta::CPAN
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|n
utf8_length||5.007001|
utf8_mg_len_cache_update|||
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr_buf||5.015009|
utf8_to_uvchr||5.007001|
lib/Acme/ppport.h view on Meta::CPAN
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
lib/Acme/ppport.h view on Meta::CPAN
#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
lib/Acme/ppport.h view on Meta::CPAN
#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)
lib/Acme/ppport.h view on Meta::CPAN
#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/Acme/Pony.pm view on Meta::CPAN
}
sub scalepony {
my @chars = @_;
my $chars = join '', @chars;
my $wantlength = length $chars;
my $scale;
# What scale do we want?
if ($wantlength > 201242) {
$scale = 1000 * sqrt($wantlength / 201242);
} else {
$scale = 1000 / sqrt(201242 / $wantlength);
}
$scale *= 0.95;
# These were worked out by hand with very accurate graph paper
my @xpoints = (0.26735840061026, 0.290728815714195, 0.297102536393109, 0.299227321848579, 0.322598690483758, 0.348092937511919, 0.36933761362914, 0.403331002479181, 0.430951624181552, 0.450073104062043, 0.471317780179264, 0.484066492912084, 0.49681...
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
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
my $signed = "Hisssssssssssssssss";
sub encode {
local $_ = unpack "b*", pop;
$_ = join ' ', map{ (/1/?'H':'h').'is'.('s' x length); } m/(0+|1+)/g;
s/(.{40,}?\s)/$1\n/g;
"$signed\n$_"
}
sub decode {
local $_ = pop;
s/(^$signed|\s)//g;
s/([hH])is(s+)/ ($1 eq 'H'?'1':'0')x(length $2); /ge;
pack "b*", $_
}
sub garbled {
$_[0] =~ /\S/
}
view release on metacpan or search on metacpan
lib/Acme/Pythonic/Functions.pm view on Meta::CPAN
if($a !~ /^\Q$b\E/) {
return $a;
}
if (length($b) > length($a)) {
return $a;
}
return substr($a, length($b));
}
sub replace {
lib/Acme/Pythonic/Functions.pm view on Meta::CPAN
if($a !~ /\Q$b\E$/) {
return $a;
}
if (length($b) > length($a)) {
return $a;
}
return substr($a, 0, length($a) - length($b));
}
sub startswith {
lib/Acme/Pythonic/Functions.pm view on Meta::CPAN
if ($lenarg != 2) {
croak "Error: 'len()' in mode 's' takes exactly 2 arguments ($lenarg given),";
}
return length($_[0]);
}
if ($mode eq "l") {
return $lenarg - 1;
}
view release on metacpan or search on metacpan
lib/Acme/Pythonic.pm view on Meta::CPAN
if (!$joining) {
$unbalanced_paren = left_parenthesize($line);
$might_be_modifier = $line =~ /^\s*(?:if|unless|while|until|for|foreach)\b/;
$line_with_modifier = \$line if $might_be_modifier;
($indent) = $line =~ /^(\s*)/;
$indent = length(expand($indent));
}
if ($line =~ /(?:,|=>)\s*$/ || $line =~ s/\\\s*$//) {
++$joining;
next if $joining > 1; # if 1 we need yet to handle indentation
lib/Acme/Pythonic.pm view on Meta::CPAN
# avoid breaking things like
#
# print for keys %main::
#
my $bracket_opened_by = '';
if ($line =~ /(:+)$/ && length($1) % 2) {
$might_be_modifier = 0;
# We perform some checks because labels have to keep their colon.
if ($line !~ /^\s*$id:$/o ||
$line =~ /[[:lower:]]/ || # labels are not allowed to have lower-case letters
$line =~ /^\s*(?:BEGIN|CHECK|INIT|END):$/) {
view release on metacpan or search on metacpan
examples/ipsfss_receive.pl view on Meta::CPAN
if ($packet_type ne '0800') {
# not an IP packet, ignore it
return;
}
print "Processing packet ...\n";
print "Packet length: " . (length($packet) - 14) . "\n";
my $sfss = Acme::RFC4824->new();
my $ascii = $sfss->encode({
TYPE => 'ASCII',
PACKET => substr($packet, 14),
});
view release on metacpan or search on metacpan
lib/Acme/Rautavistic/Sort.pm view on Meta::CPAN
it. Then move to the next number.
After a single pass of this algorithm, the list will only contain
numbers that are at least as large as the previous number in the
list. In other words, the list will be sorted! Analysis Dropsort
requires exactly n-1 comparisons to sort a list of length n, making
this an O(n) algorithm, superior to the typical O(n logn) algorithms
commonly used in most applications.
Dropsort is what is known in the computer science field as a lossy
algorithm. It produces a fast result that is correct, but at the cost