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;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
}
push @full_reports, "\n";
}
}
view all matches for this distribution
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;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Pythonic.pm view on Meta::CPAN
} else {
$joining = 0;
}
# Handle trailing colons, which can be Pythonic, mark a labeled
# block, mean some map, or &-sub call, etc.
#
# We check the parity of the number of ending colons to try to
# avoid breaking things like
#
# print for keys %main::
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/RFC4824.pm view on Meta::CPAN
use Carp;
use bytes;
our $VERSION = '0.02';
# a hash ref of mappings from ASCII to ASCII art representations
has 'ascii2art_map' => (
is => 'ro',
);
# the default SFS frame size in bytes
has 'default_framesize' => (
lib/Acme/RFC4824.pm view on Meta::CPAN
if ($arg_ref->{'DEFAULT_FRAMESIZE'} > 255) {
croak "Frame size too large, can at most be 255";
}
$self->{'default_framesize'} = $arg_ref->{'DEFAULT_FRAMESIZE'};
}
# initialize mapping from characters to ASCII art
# ASCII-Art comes directly from RFC4824
$self->{'ascii2art_map'}->{'A'} = << 'XEOF';
0
/||
/ \
XEOF
$self->{'ascii2art_map'}->{'B'} = << 'XEOF';
__0
||
/ \
XEOF
$self->{'ascii2art_map'}->{'C'} = << 'XEOF';
\0
||
/ \
XEOF
$self->{'ascii2art_map'}->{'D'} = << 'XEOF';
|0
||
/ \
XEOF
$self->{'ascii2art_map'}->{'E'} = << 'XEOF';
0/
||
/ \
XEOF
$self->{'ascii2art_map'}->{'F'} = << 'XEOF';
0__
||
/ \
XEOF
$self->{'ascii2art_map'}->{'G'} = << 'XEOF';
0
||\
/ \
XEOF
$self->{'ascii2art_map'}->{'H'} = << 'XEOF';
__0
/|
/ \
XEOF
$self->{'ascii2art_map'}->{'I'} = << 'XEOF';
\0
/|
/ \
XEOF
$self->{'ascii2art_map'}->{'J'} = << 'XEOF';
|0__
|
/ \
XEOF
$self->{'ascii2art_map'}->{'K'} = << 'XEOF';
0|
/|
/ \
XEOF
$self->{'ascii2art_map'}->{'L'} = << 'XEOF';
0/
/|
/ \
XEOF
$self->{'ascii2art_map'}->{'M'} = << 'XEOF';
0__
/|
/ \
XEOF
$self->{'ascii2art_map'}->{'N'} = << 'XEOF';
0
/|\
/ \
XEOF
$self->{'ascii2art_map'}->{'O'} = << 'XEOF';
_\0
|
/ \
XEOF
$self->{'ascii2art_map'}->{'P'} = << 'XEOF';
__0|
|
/ \
XEOF
$self->{'ascii2art_map'}->{'Q'} = << 'XEOF';
__0/
|
/ \
XEOF
$self->{'ascii2art_map'}->{'R'} = << 'XEOF';
__0__
|
/ \
XEOF
$self->{'ascii2art_map'}->{'S'} = << 'XEOF';
__0
|\
/ \
XEOF
$self->{'ascii2art_map'}->{'T'} = << 'XEOF';
\0|
|
/ \
XEOF
$self->{'ascii2art_map'}->{'U'} = << 'XEOF';
\0/
|
/ \
XEOF
$self->{'ascii2art_map'}->{'V'} = << 'XEOF';
|0
|\
/ \
XEOF
$self->{'ascii2art_map'}->{'W'} = << 'XEOF';
0/_
|
/ \
XEOF
$self->{'ascii2art_map'}->{'X'} = << 'XEOF';
0/
|\
/ \
XEOF
$self->{'ascii2art_map'}->{'Y'} = << 'XEOF';
\0__
|
/ \
XEOF
$self->{'ascii2art_map'}->{'Z'} = << 'XEOF';
0__
|\
/ \
XEOF
return 1;
lib/Acme/RFC4824.pm view on Meta::CPAN
}
else { # ASCII-ART
my @sfss_ascii_art_frames = ();
for (my $i = 0; $i < length($sfs_frame); $i++) {
my $char = substr($sfs_frame, $i, 1);
my $aa_repr = $self->ascii2art_map->{$char};
if (! defined $aa_repr) {
die "No ASCII-Art representation for '$char'";
}
push @sfss_ascii_art_frames, $aa_repr;
}
lib/Acme/RFC4824.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Acme::RFC4824 - Internet Protocol over Semaphore Flag Signaling System (SFSS)
=head1 VERSION
Version 0.01
=head1 SYNOPSIS
This module is used to help you implement RFC 4824 - The Transmission
of IP Datagrams over the Semaphore Flag Signaling System (SFSS).
It can be used to convert IP datagrams to SFS frames and the other
way round. Furthemore, it can be used to display an ASCII art representation
of the SFS frame.
lib/Acme/RFC4824.pm view on Meta::CPAN
An ASCII representation of the SFS frame which you would like to decode
into an IP datagram.
=back
=head2 ascii2art_map
Read-only accessor for the attribute with the same name.
Returns a hash reference that maps SFS ASCII characters to an ASCII art
representation of the given character. There is probably no need to use
this from the outside.
=head2 default_framesize
view all matches for this distribution
view release on metacpan or search on metacpan
my $quote = rando();
ok($quote);
my @quotes = map { rando() } 0 .. 10;
my %quotes = map { $_ => 1 } @quotes;
cmp_ok(scalar keys %quotes, '>', 1);
view all matches for this distribution
view release on metacpan or search on metacpan
author/generate.pl view on Meta::CPAN
use Data::Dump ();
chdir $FindBin::Bin;
my $http = HTTP::Tiny->new;
my %url = map {; "http://unicode.org/Public/emoji/latest/$_" => undef } qw(
emoji-data.txt
emoji-zwj-sequences.txt
emoji-sequences.txt
);
author/generate.pl view on Meta::CPAN
$url{$url} = path($file)->slurp_utf8;
}
sub load_emoji {
my @content = @_;
my @line = map { split /\n/, $_ } @content;
my @chr;
while (defined(my $line = shift @line)) {
chomp $line;
$line =~ s/^\s+//; $line =~ s/\s+$//;
next if !$line || $line =~ /^#/;
author/generate.pl view on Meta::CPAN
$chr .= "\N{U+FE0F}" if $point < 256;
push @chr, $chr;
}
} else {
my @item = split /\s+/, $line;
my $chr = join "", map { chr hex $_ } @item;
push @chr, $chr
}
}
\@chr;
}
my $emoji = load_emoji( map { $url{$_} } sort keys %url );
my $dump = Data::Dump::dump($emoji);
warn "-> write ../lib/Acme/RandomEmoji.pm\n";
my $template = path("RandomEmoji.pm")->slurp_utf8;
$template =~ s/## REPLACE ##/$dump/;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Rautavistic/Sort.pm view on Meta::CPAN
%EXPORT_TAGS = (all => [ qw(dropsort dropsortx) ]);
sub dropsort {
no warnings 'uninitialized';
my $last;
map { $_ ge $last ? $last = $_ : () } @_;
}
sub dropsortx(&@)
{
# magic variables $a and $b
lib/Acme/Rautavistic/Sort.pm view on Meta::CPAN
local(*{$caller."::a"}) = \my $a;
local(*{$caller."::b"}) = \my $b;
my $comparator = shift;
my $last;
map {
$a = $_;
$b = $last;
$comparator->() >= 0 ? $last = $_ : ()
} @_;
}
view all matches for this distribution
view release on metacpan or search on metacpan
*
* The result will be a list of patches suggesting changes that should at
* least be acceptable, if not necessarily the most efficient solution, or a
* fix for all possible problems. It won't catch where dTHR is needed, and
* doesn't attempt to account for global macro or function definitions,
* nested includes, typemaps, etc.
*
* In order to test for the need of dTHR, please try your module under a
* recent version of Perl that has threading compiled-in.
*
*/
$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
$replace = $1 if /Replace:\s+(\d+)/;
$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
}
foreach $filename (map(glob($_),@ARGV)) {
unless (open(IN, "<$filename")) {
warn "Unable to read from $file: $!\n";
next;
}
print "Scanning $filename...\n";
}
}
if (scalar(keys %add_func) or $need_include != $has_include) {
if (!$has_include) {
$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
"#include \"ppport.h\"\n";
$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
} elsif (keys %add_func) {
$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
}
if (!$need_include) {
print "Doesn't seem to need ppport.h.\n";
$c =~ s/^.*#.*include.*ppport.*\n//m;
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Normalise multipart versions
$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 all matches for this distribution
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 all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Resume/Types.pm view on Meta::CPAN
as ArrayRef[Education],
message { sprintf "Those are not Education objects." };
coerce Educations,
from ArrayRef[HashRef],
via { [ map { 'Acme::Resume::Types::Education'->new($_) } @$_ ] };
coerce Educations,
from HashRef,
via { [ 'Acme::Resume::Types::Education'->new(%$_) ] };
lib/Acme/Resume/Types.pm view on Meta::CPAN
as ArrayRef[Job],
message { sprintf "Those are not Job objects." };
coerce Jobs,
from ArrayRef[HashRef],
via { [ map { 'Acme::Resume::Types::Job'->new($_) } @$_ ] };
coerce Jobs,
from HashRef,
via { [ 'Acme::Resume::Types::Job'->new(%$_) ] };
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/ReturnValue.pm view on Meta::CPAN
'file' => $filename,
'package' => $this_package,
'PPI' => ref $match,
};
my @bad = map { 'PPI::Statement::'.$_} qw(Sub Variable Compound Package Scheduled Include Sub);
if (any { ref($match) eq $_ } @bad) {
$data->{'bad'}=$rv;
push(@{$self->bad},$data);
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/RunDoc.pm view on Meta::CPAN
my ($class, $module) = _args(@_);
(my $filename = Module::Runtime::module_notional_filename($module))
=~ s{ \.pm $ }{ '.docm' }ex;
my ($file) =
grep { -e $_ }
map { File::Spec->catfile($_, $filename) }
@INC;
Carp::croak("Could not find $filename in \@INC: ".join q{ }, @INC)
unless defined $file;
$class->require_file($file);
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/SaBalTongMun.pm view on Meta::CPAN
sub generate {
my $self = shift;
my $max_string_width
= max( map length, @{$self->people} ) * $self->font_size;
my $cx = $self->radius + $max_string_width;
my $cy = $self->radius + $max_string_width;
my $width = ( $self->radius + $max_string_width ) * 2;
my $height = ( $self->radius + $max_string_width ) * 2;
lib/Acme/SaBalTongMun.pm view on Meta::CPAN
$string_angle, # rotation angle
$dest_x, # X coordinates
$dest_y, # Y coordinates
$string,
{
charmap => $self->font_charset,
},
);
$dest_angle += $angle;
}
return $image;
}
sub _get_rgb { map hex, $_[0] =~ m/^#(..)(..)(..)$/ }
__PACKAGE__->meta->make_immutable;
no Moose;
1;
lib/Acme/SaBalTongMun.pm view on Meta::CPAN
which is the center circle of the round robin.
=head2 font
This attribute stores the TrueType(*.ttf) font path.
Only the font which has unicode charmap is allowed.
=head2 font_size
This attribute stores the size of the font.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Samurai.pm view on Meta::CPAN
if ($node->pos1 eq 'æ°' and $node->surface =~ /^[0-9]+$/) {
# no ä½
if ($node->surface =~ /^0/ or
$node->prev && $node->prev->surface =~ /[.ï¼]/) {
$text = join "", map { num2ja($_) } split //, $node->surface;
} else {
$text = num2ja($node->surface); # with ä½
}
}
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
# (hide CPAN::Meta from prereq scanner)
my $cpan_meta = "CPAN::Meta";
if ( -f "MYMETA.json" && eval "require $cpan_meta" ) { ## no critic
if ( my $meta = eval { CPAN::Meta->load_file("MYMETA.json") } ) {
my $prereqs = $meta->prereqs;
my %uniq = map {$_ => 1} map { keys %$_ } map { values %$_ } values %$prereqs;
$uniq{$_} = 1 for @modules; # don't lose any static ones
@modules = sort keys %uniq;
}
}
t/00-report-prereqs.t view on Meta::CPAN
push @reports, ["missing", $mod];
}
}
if ( @reports ) {
my $vl = max map { length $_->[0] } @reports;
my $ml = max map { length $_->[1] } @reports;
splice @reports, 1, 0, ["-" x $vl, "-" x $ml];
diag "Prerequisite Report:\n", map {sprintf(" %*s %*s\n",$vl,$_->[0],-$ml,$_->[1])} @reports;
}
pass;
# vim: ts=2 sts=2 sw=2 et:
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Scurvy/Whoreson/BilgeRat/Backend/insultserver.pm view on Meta::CPAN
next if /^\s*$/;
next if /^\s*#/;
next unless s!^\s*(adj|amt|noun)\s+!!i;
my $what = $1;
# turn the '|' character into a space
push @{$self->{$what}}, map { s!\|! !g; $_ } split ' ', $_;
}
seek DATA, $pos,0;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/SexualReproduction.pm view on Meta::CPAN
my ($id, $chromosomes) = @_;
croak "\$chromosomes must be a HASH reference" unless ref $chromosomes eq 'HASH';
tie my $sperm, 'IPC::Shareable', {key => $id, create => 1 } or carp("Couldn't copulate with male process: $!"), return;
sleep 0.5 while !keys %$sperm; # foreplay
keys %$sperm eq keys %$chromosomes or carp("Chromosome mismatch"), return;
my %child_chromosomes = map { $_, int rand 2 ? $chromosomes->{$_} : $sperm->{$_} } keys %$chromosomes;
my $pid = fork;
carp("Couldn't spawn a child: $!"), return unless defined $pid;
%$chromosomes = %child_chromosomes if $pid == 0;
return $pid;
}
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.03';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
inc/Module/AutoInstall.pm view on Meta::CPAN
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
inc/Module/AutoInstall.pm view on Meta::CPAN
if (
defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) )
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
push @required, $mod => $arg;
}
inc/Module/AutoInstall.pm view on Meta::CPAN
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
$UnderCPAN = _check_lock(); # check for $UnderCPAN
inc/Module/AutoInstall.pm view on Meta::CPAN
sub install {
my $class = shift;
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
my ( @modules, @installed );
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
inc/Module/AutoInstall.pm view on Meta::CPAN
}
$args{test}{TESTS} ||= 't/*.t';
$args{test}{TESTS} = join( ' ',
grep { !exists( $DisabledTests{$_} ) }
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
my $missing = join( ',', @Missing );
my $config =
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Siteswap.pm view on Meta::CPAN
sub _check_timing {
my ($self, @throws) = @_;
# foreach non-zero throw, mark where the ball will next be
# thrown and make sure that each throw is fed.
my @throw_map = map { ref $_ eq 'ARRAY' ? scalar(@$_)
: ( $_ > 0 ? 1 : 0 ) } @throws;
my @feeds = (0) x scalar @throws;
for my $i (0 .. $#throws) {
my @subthrows = ref $throws[$i] eq 'ARRAY' ? @{$throws[$i]}
: ($throws[$i]);
lib/Acme/Siteswap.pm view on Meta::CPAN
$feeds[$next_thrown]++;
}
}
for my $i (0 .. $#throws) {
if ($feeds[$i] != $throw_map[$i]) {
$self->{error} = "Multiple throws would land at the same time.";
return 0;
}
}
return 1;
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
delete $args->{SIGN};
}
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_,
($self->build_requires, $self->requires) );
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
inc/Module/Install/Makefile.pm view on Meta::CPAN
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
if ($self->admin->preop) {
$args{dist} = $self->admin->preop;
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
view all matches for this distribution
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
my $pending = 0;
$_->{ready} or $pending++ for @subs;
# Look for immediate done
if( !$pending ) {
$self->{result} = [ map { $_->get } @subs ];
$self->_mark_ready( "needs_all" );
return $self;
}
weaken( my $weakself = $self );
local/lib/perl5/Future.pm view on Meta::CPAN
}
else {
$pending--;
$pending and return;
$weakself->{result} = [ map { $_->get } @subs ];
$weakself->_mark_ready( "needs_all" );
}
};
foreach my $sub ( @subs ) {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/Spork.pm view on Meta::CPAN
close $PARENT_WTR;
for my $stdfh (qw(STDIN STDOUT STDERR)) {
close $stdfh;
if(exists $reopen_stdfhs_to{ $stdfh } && ref $reopen_stdfhs_to{ $stdfh } eq 'ARRAY') {
eval "open( $stdfh, " . join(', ', map { qq{"$_"} } @{ $reopen_stdfhs_to{ $stdfh } }) . ' );';
carp "Could not reopen $stdfh : $@" if $@;
# no strict 'refs';
# open( $stdfh , @{ $reopen_stdfhs_to{ $stdfh } }) or carp "Could not reopen $stdfh : $!";
}
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/State.pm view on Meta::CPAN
What could possibily go wrong?
=head1 SEE ALSO
You *could* use an ORM, and wind up translating all of your data to a relational schema you
don't care about or else have it automatically mapped and completely miss the point of
using a relational database.
You *could* just store your data in the Ether with Memcached.
You could C<INSERT> and C<UPDATE> manually against a database to store every little tidbit and factoid
as they're computed.
You could use BerekelyDB, including the build-in legacy C<dbmopen> and mangle everything
view all matches for this distribution
view release on metacpan or search on metacpan
Stegano/Stegano.pm view on Meta::CPAN
}
sub insert
{
my ($self,$text) = @_;
my ($max_str,$max_cont,@map_letters) = (0,0);
my $binstr = unpack "b*", " $text"; # It must begin with 0
$_ > $max_str and $max_str = $_ for map { length } @$self;
while ($binstr =~ /((.)\2*)/g)
{
my $len = length($1);
$max_cont = $len if $len > $max_cont;
push(@map_letters,$len);
}
my @map_file = map { $max_str - length($_) > $max_cont } @$self;
for (my $i=0;$i<@$self;$i++)
{
$self->[$i] .= " " x shift(@map_letters)
if $map_file[$i] and @map_letters;
}
carp "Text is not enougth large to insert all chars" if @map_letters;
return ! @map_letters;
}
sub extract
{
my $self = shift;
view all matches for this distribution
view release on metacpan or search on metacpan
}
$got{$section} = $datum;
}
carp "Did not find first section in files @_" unless defined $length;
my $data = join '', map {$got{$_}} sort {$a <=> $b} keys %got;
substr ($data, $length) = '';
$data;
}
view all matches for this distribution
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 all matches for this distribution
view release on metacpan or search on metacpan
DateLocales.pm view on Meta::CPAN
@res;
}
sub weekday_and_month_names_dump {
my @res = weekday_and_month_names();
join "\n", map {
Data::Dumper->new([$_],['r'])->Useqq(1)->Indent(0)->Sortkeys(1)->Dump
} @res;
}
# REPO BEGIN
view all matches for this distribution
view release on metacpan or search on metacpan
examples/bench-parm-parsers-ci-novalid.pl view on Meta::CPAN
sub caseflat_standard_args {
my %args;
{
my %raw_args = @_;
%args = map { lc($_) => $raw_args{$_} } keys %raw_args;
}
my ($handle, $thing) = @args{'handle','thing'};
}
view all matches for this distribution