view release on metacpan or search on metacpan
my $oos = Acme::Pills::out_of_stock( 'foobar', 'foo/bar.pm' );
like( <$oos>, qr/print.+foobar is out of stock/,
'out_of_stock() should print an out of stock message' );
ok( ! $INC{'foo/bar.pm'}, '... not populating %INC for module' );
my @breaks = map { Acme::Pills::breaks() ? 1 : () } 1 .. 1000;
cmp_ok( @breaks, '>', 75,
'breaks() should be true more than 7.5% of the time' );
cmp_ok( @breaks, '<', 125,
'... and false less than 12.5% of the time' );
my @subs = map { Acme::Pills::bad_product() } 1 .. 2000;
my @empty = grep { $_ == \&Acme::Pills::empty_box } @subs;
cmp_ok( @empty, '>', 150,
'empty_box() should be called more than 7.5% of the time' );
cmp_ok( @empty, '<', 250,
'... and less than 12.5% of the time' );
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 release on metacpan or search on metacpan
lib/Acme/PlayCode.pm view on Meta::CPAN
while ( $old_flag++ ) {
push @next_tokens, $tokens[$old_flag];
last if ( $tokens[$old_flag]->content eq ';' );
}
push @output, $token->content,
join('', map { $_->content } @next_tokens ), "\n",
join('', $token->heredoc),
$token->terminator;
# skip next itself and next ';'
$self->token_flag( $token_flag + 1 + scalar @next_tokens );
view release on metacpan or search on metacpan
lib/Acme/ppport.h view on Meta::CPAN
}
else {
$opt{'compat-version'} = 5;
}
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
(index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
lib/Acme/ppport.h view on Meta::CPAN
_aMY_CXT|5.007003||p
_add_range_to_invlist|||
_append_range_to_invlist|||
_core_swash_init|||
_get_encoding|||
_get_regclass_nonbitmap_data|||
_get_swash_invlist|||
_invlist_array_init|||n
_invlist_contains_cp|||n
_invlist_contents|||
_invlist_dump|||
lib/Acme/ppport.h view on Meta::CPAN
ptr_table_free||5.009005|
ptr_table_new||5.009005|
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_charclass_bitmap_innards|||
put_code_point|||
put_range|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
lib/Acme/ppport.h view on Meta::CPAN
$replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
$replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
$replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
my @deps = map { s/\s+//g; $_ } split /,/, $3;
my $d;
for $d (map { s/\s+//g; $_ } split /,/, $1) {
push @{$depends{$d}}, @deps;
}
}
$need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
lib/Acme/ppport.h view on Meta::CPAN
exit 0;
}
my @files;
my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
my $srcext = join '|', map { quotemeta $_ } @srcext;
if (@ARGV) {
my %seen;
for (@ARGV) {
if (-e) {
lib/Acme/ppport.h view on Meta::CPAN
$File::Find::name =~ /($srcext)$/i
and push @files, $File::Find::name;
}, '.');
};
if ($@) {
@files = map { glob "*$_" } @srcext;
}
}
if (!@ARGV || $opt{filter}) {
my(@in, @out);
my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
for (@files) {
my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
push @{ $out ? \@out : \@in }, $_;
}
if (@ARGV && @out) {
lib/Acme/ppport.h view on Meta::CPAN
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
return () if $seen->{$func}++;
my %s;
grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
}
sub parse_version
{
my $ver = shift;
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
my %WriteMakefileArgs = (
ABSTRACT => $meta->{abstract},
AUTHOR => ($EUMM >= 6.5702 ? $meta->{author} : $meta->{author}[0]),
DISTNAME => $meta->{name},
VERSION => $meta->{version},
EXE_FILES => [ map $_->{file}, values %{ $meta->{x_provides_scripts} || {} } ],
NAME => do { my $n = $meta->{name}; $n =~ s/-/::/g; $n },
test => { TESTS => "t/*.t" },
%dynamic_config,
);
Makefile.PL view on Meta::CPAN
}
{
my ($minperl) = reverse sort(
grep defined && /^[0-9]+(\.[0-9]+)?$/,
map $meta->{prereqs}{$_}{requires}{perl},
qw( configure build runtime )
);
if (defined($minperl))
{
view release on metacpan or search on metacpan
lib/Acme/Pony.pm view on Meta::CPAN
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...
# ... or I may have used Sketch...
my @ypoints = (0.0303060573188429, 0.0417852818858603, 0.0264797254557372, 0.0150004436442946, 0.0417852818858603, 0.0666571259291486, 0.0685702346162763, 0.0915289699724368, 0.118313922702853, 0.141272371836888, 0.169970719476557, 0.21014800546111...
# Scale the points (with ASCII 'fixed' font size scaling too)
@xpoints = map { $_ *= $scale; $_ = int($_) } @xpoints;
@ypoints = map { $_ *= $scale * 5 / 9; $_ = int($_) } @ypoints;
my $n = @xpoints;
return if ($n < 3); # not even a triangle, boring
# Find the min and max y values
lib/Acme/Pony.pm view on Meta::CPAN
This is based on Leon Brocard's 'Buffy' module and inspired by Damian
Conway's brief talk on his Bleach module.
Leon contributed the code for scaling a vector Pony and filling it,
replacing the bitmap Pony from the previous versions.
=head1 COPYRIGHT
Copyright (c) 2001, David Cantrell. The Artistic Licence applies.
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 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 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 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 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 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 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 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 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 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 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
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 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 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 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 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 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 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 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 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 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 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 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 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 ) {