view release on metacpan or  search on metacpan

t/00-compile.t  view on Meta::CPAN

51
52
53
54
55
56
57
58
59
60
61
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/CPANModules/Import/PerlAdvent/2018.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
package Acme::CPANModules::Import::PerlAdvent::2018;
 
our $DATE = '2018-12-30'; # DATE
our $VERSION = '0.001'; # VERSION
 
our $LIST = {description=>"This list is generated by extracting module names mentioned in [http://perladvent.org/2018/] (retrieved on 2018-12-30). Visit the URL for the full contents.",entries=>[{module=>"Memoize"},{module=>"Convert::ASN1"},{module=>...
 
1;
# ABSTRACT: Modules mentioned in Perl Advent Calendar 2018
 
__END__

lib/Acme/CPANModules/Import/PerlAdvent/2018.pm  view on Meta::CPAN

48
49
50
51
52
53
54
55
56
57
 
=item * L<JSON::XS>
 
=item * L<XML::Compile::SOAP>
 
=item * L<Data::Rmap>
 
=item * L<Array::Sticky>
 
=item * L<Array::Sticky::INC>

 view release on metacpan or  search on metacpan

t/00-compile.t  view on Meta::CPAN

52
53
54
55
56
57
58
59
60
61
62
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

t/00-compile.t  view on Meta::CPAN

48
49
50
51
52
53
54
55
56
57
58
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

t/00-compile.t  view on Meta::CPAN

48
49
50
51
52
53
54
55
56
57
58
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

t/00-compile.t  view on Meta::CPAN

53
54
55
56
57
58
59
60
61
62
63
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

t/00-compile.t  view on Meta::CPAN

50
51
52
53
54
55
56
57
58
59
60
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

devdata/http_advent.perldancer.org_2018_16  view on Meta::CPAN

110
111
112
113
114
115
116
117
118
119
120
121
122
    return 1 if $self->get_invalid_queues( @queues );
    return 0;
}
 
sub get_invalid_queues( $self, @queues ) {
    my %queue_map;
    @queue_map{ @QUEUE_TYPES } = (); 
    my @invalid_queues = grep !exists $queue_map{ $_ }, @queues;
    return @invalid_queues;
}</pre>
 
<p>With that in place, it was easy for our <code>queue_job()</code> method to throw an error if the developer tried to add a job to an invalid queue:</p>
<pre class="prettyprint">sub queue_job( $self, $args ) {

 view release on metacpan or  search on metacpan

t/00-compile.t  view on Meta::CPAN

31
32
33
34
35
36
37
38
39
40
41
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/CPANModules/Import/RSAVAGE/ClassesRolesWithMooAndMoos.pm  view on Meta::CPAN

4
5
6
7
8
9
10
11
12
13
14
 
our $DATE = '2018-09-22'; # DATE
our $VERSION = '0.001'; # VERSION
 
our $LIST = {
  description => "This list is generated by extracting module names mentioned in the article [http://savage.net.au/Module-reviews/html/gci.2012.url.mapper.modules.html] (retrieved on 2016-02-21). For the full article, visit the URL.",
  entries     => [
                   { module => "CGI::Application::Plugin::ActionDispatch" },
                   { module => "CGI::Application::Plugin::REST" },
                   { module => "CGI::Application::Plugin::Routes" },
                   { module => "CGI::Application::URIMapping" },

lib/Acme/CPANModules/Import/RSAVAGE/ClassesRolesWithMooAndMoos.pm  view on Meta::CPAN

65
66
67
68
69
70
71
72
73
74
 
=head1 DESCRIPTION
 
Classes and Roles with Moo and Moos (2012).
 
This list is generated by extracting module names mentioned in the article [http://savage.net.au/Module-reviews/html/gci.2012.url.mapper.modules.html] (retrieved on 2016-02-21). For the full article, visit the URL.
 
=head1 INCLUDED MODULES
 
=over

 view release on metacpan or  search on metacpan

t/00-compile.t  view on Meta::CPAN

36
37
38
39
40
41
42
43
44
45
46
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

t/00-compile.t  view on Meta::CPAN

31
32
33
34
35
36
37
38
39
40
41
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

t/00-compile.t  view on Meta::CPAN

35
36
37
38
39
40
41
42
43
44
45
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

t/00-compile.t  view on Meta::CPAN

31
32
33
34
35
36
37
38
39
40
41
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

t/00-compile.t  view on Meta::CPAN

30
31
32
33
34
35
36
37
38
39
40
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

t/00-compile.t  view on Meta::CPAN

30
31
32
33
34
35
36
37
38
39
40
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/Cake.pm  view on Meta::CPAN

57
58
59
60
61
62
63
64
65
66
67
AZMo3+wM3GuxVZREk0+VREuAJ5OnHPfH5FVonTNN1mUIl44vlcMKlxoQHNKDjkr5OpcIVRRtj/BE
DfRldgBpH8UQMmXIEuIgE2aRk65KG5Uidzb5YDsW/kAsxzQUuV2WDPai1BJWioYVZFOmiZydUBhL
gEVFovG+wLasvDxFxsDUqLMqHJIlStkU30QwFVjUbA1jFJUFFQiM0PqQpdiDinjnD8kdGDKlBRlw
15N3tGzarg5p3GTJAbmDb8sCbGnZQABlOX3cDxy+9FHTFsrsyFtQVRAESdL5KMAirZpGlBRFDhGQ
KCXQRtBVGijKk4KRlOO10UIcVutMCHFxdMKKi/o/JLwvwgLhFrsoiomuCEuQjWCo0TQETg3ylwQo
L2KK2oVECaCFp9gbKQMikNAJkyjuVMDB42pV/mapUqKhPgzk7CpGuCo7ISUopjIGp7Xx2bx1N/mv
7FlSws2dONQ89nKxSJFKKaphXJki4SplY5Nfoo2hJORqZEybTBStgDJf28oovfFrmjPIo5FXQGMs
Ml1yTGbgwrpxyUlaLsyCMigE0Q1QDHRFKioSpNAE52qIQFFp/aiAbdcEp32Aw2tgCgvcJfbGyjJT
dmiKG1wQAJ+AASgUlQCpWMAk6i2YNgTJWiaKhpFrgCrZUeGmBuhMyoHFckFCcUFBUOwKYBCoTKIl
TVM58kNv6NRBCbj+i2o5PNNAQ1Q9lgRKLi+Sd1MopMmT44AzYFR1YZblz2jVdmaoZLIIlL2J7KJc
L5sIqiopioKpdlICrIbd9kDhkcXT6Ky800BkSslS4KN3FSXJG3a/giNAClNcWSmBUY7v0W4RS4QR

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

401
402
403
404
405
406
407
408
409
410
411
                # 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/Chef.pm  view on Meta::CPAN

88
89
90
91
92
93
94
95
96
97
   $_->compile() foreach @recipes;
 
   $self->{start_recipe} = $recipes[0]->recipe_name();
 
   $self->{recipes} = {
                        map { ($_->recipe_name(), $_) } @recipes
                      };
 
   return $self;
}

 view release on metacpan or  search on metacpan

t/pod-spelling.t  view on Meta::CPAN

4
5
6
7
8
9
10
11
12
13
14
plan skip_all => 'POD tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'};
 
eval 'use Test::Spelling 0.19';
plan skip_all => 'Test::Spelling v0.19 required for testing POD' if $@;
 
add_stopwords( map { split /[\s\:\-]/ } readline(*DATA) );
$ENV{LANG} = 'C';
all_pod_files_spelling_ok();
 
__DATA__
MERCHANTABILITY

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

441
442
443
444
445
446
447
448
449
450
451
                # 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

Makefile.PL  view on Meta::CPAN

1
2
3
4
5
6
7
8
BEGIN {
  use strict; use warnings;
  my %missing = map {
    eval qq{ require $_ };
    $@ ? ($_=>1) : ()
  } qw( experimental warnings );
  if(%missing)
  {

 view release on metacpan or  search on metacpan

lib/Acme/Colour/Fuzzy.pm  view on Meta::CPAN

123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
# FIXME use some real metric, not made-up computations
my $max_distance = $similar[-1]{distance};
my $pivot = max( ( $max_distance * 9 / 13 ), 1 );
foreach my $similar ( @similar ) {
    my @words = map { /^(dark)(\w+)/ ? ( $1, $2 ) : ( $_ ) }
                map { s/\d+//; $_ } # remove numbers
                    split /[ \-]+/, $similar->{name};
    my $weight = ( $pivot - $similar->{distance} ) / $pivot;
    foreach( @words ) {
        $words{$_} += $weight;
    }
}
my @weights = sort { $b->[1] <=> $a->[1] }
              map  [ $_ => $words{$_} ],
                   keys %words;
 
my @names;
my $first_weight = $weights[0][1];
foreach my $weight ( @weights ) {

 view release on metacpan or  search on metacpan

lib/Acme/Colour.pm  view on Meta::CPAN

36
37
38
39
40
41
42
43
44
45
46
tie my %COLOURS, 'Graphics::ColorNames', 'X';
 
foreach my $colour ( keys %COLOURS ) {
    next if $colour =~ /\d/;
    my ( $r, $g, $b )
        = map { hex($_) / 255 }
        ( $COLOURS{$colour}
            =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i
        );
    $r{$colour} = $r;
    $g{$colour} = $g;

 view release on metacpan or  search on metacpan

inc/Module/Install/Makefile.pm  view on Meta::CPAN

105
106
107
108
109
110
111
112
113
114
115
                die "tests_recursive dir '$dir' does not exist";
        }
        require File::Find;
        %test_dir = ();
        File::Find::find( \&_wanted_t, $dir );
        $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
 
sub write {
        my $self = shift;
        die "&Makefile->write() takes no arguments\n" if @_;

inc/Module/Install/Makefile.pm  view on Meta::CPAN

137
138
139
140
141
142
143
144
145
146
147
148
}
 
# 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

inc/Module/Install/Makefile.pm  view on Meta::CPAN

161
162
163
164
165
166
167
168
169
170
171
                . "but we need version >= $perl_version";
}
 
$args->{INSTALLDIRS} = $self->installdirs;
 
my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
 
my $user_preop = delete $args{dist}->{PREOP};
if (my $preop = $self->admin->preop($user_preop)) {
        $args{dist} = $preop;
}

 view release on metacpan or  search on metacpan

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

898
899
900
901
902
903
904
905
906
907
908
if ( my $p = $redstring->{myth_place} ) {
        push @x, (
                "there are clues about $p in the Bible",
                "there are clues about $p in the Voynich manuscript",
                "$p is on some old maps",
                "$p is on Google Maps",
        );
}
 
if ( my $art = $redstring->{artifact} ) {

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
        push @x, (
                "the Wikipedia entry for $p keeps getting edited by $bad",
                # This has singular/plural problems - how to solve?
                "$bad has ties to $p",
                "$p probably isn't a real place anyway",
                "$p isn't shown on any maps",
        );
}
 
for my $actor ( qw/ protagonists antagonists / ) {
        next unless $redstring->{$actor}{name};

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
                        "'$name' is an anagram of '$topicname' (if you spell it wrong)",
                );
        }
}
 
my @evidences = List::Util::uniq( map { _RANDOM_(@x) } 1..2 );
 
if ( @evidences == 2 ) {
        my ( $e1, $e2 ) = @evidences;
        return _RANDOM_(
                "You can tell this is the truth because $e1, and $e2.",

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
sub numerology {
        my $redstring = shift // {};
         
        my @strings = List::Util::uniq(
                grep { length }
                map { my $letters = uc( $_ ); $letters =~ s/[^A-Z0-9]//g; $letters }
                map {
                        /^(the )(.+)$/i ? $2 : $_
                }
                map {
                        ref( $_ ) ? grep( defined, $_->{name}, $_->{shortname}, $_->{title}, $_->{author} ) : $_
                }
                values( %$redstring )
        );
         
        my %calcs;
        foreach my $string ( @strings ) {
                next if length($string) >= 20;
                my @letters = split //, $string;
                my @numbers = map /[A-Z]/ ? ( ord($_) - 0x40 ) : $_, @letters;
                my $sum     = List::Util::sum( @numbers );
                 
                push @{ $calcs{$sum} ||= [] }, sprintf(
                        '%s = %s = %s',
                        join( '+', @letters ),

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
                        push @{ $calcs{$key} }, "And guess what? " . $statement;
                }
        }
}
 
my @wow = map { @$_ > 1 ? @$_ : () } values %calcs;
 
if ( @wow ) {
        return sprintf(
                "%s %s",
                _RANDOM_(

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
                        'Trust the numbers.',
                        'You can see the truth in the numbers.',
                ),
                join(
                        '',
                        map( "$_. ", @wow ),
                )
        );
}
 
return '';

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

49
50
51
52
53
54
55
56
57
58
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

99
100
101
102
103
104
105
106
107
108
109
}
 
{
        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

inc/Module/Install.pm  view on Meta::CPAN

401
402
403
404
405
406
407
408
409
410
411
                # 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/Cow/Interpreter.pm  view on Meta::CPAN

33
34
35
36
37
38
39
40
41
42
43
 
use Carp;
 
our $VERSION = '0.02';
 
# This hash maps each of the 12 command (used in the source code) to the
# corresponding numerical code, from 0 to 11.
 
my $cmd2code =
  {
   moo =>  0,

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

52
53
54
55
56
57
58
59
60
61
62
   MMM =>  9,
   OOM => 10,
   oom => 11,
  };
 
# This array maps each of the 12 numerical codes to the corresponding
# command (used in source code).
 
my $code2cmd =
  [
   'moo',

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

223
224
225
226
227
228
229
230
231
232
233
    $self -> init();
 
    # Find the string commands, and convert them to numerical codes.
 
    $self -> {prog} = [
                        map { $cmd2code -> {$_} }
                          $string =~ /($cmd_regex)/go
                      ];
 
    return $self;
}

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

270
271
272
273
274
275
276
277
278
279
# Iterate over each line, find the string commands, and convert them to
# numerical codes.
 
while (<FILE>) {
    push @{ $self -> {prog} },
      map { $cmd2code -> {$_} }
        /($cmd_regex)/go;
}
 
close FILE or croak "$file: can't close file after reading: $!";

 view release on metacpan or  search on metacpan

Cow/TextBalloon.pm  view on Meta::CPAN

179
180
181
182
183
184
185
186
187
188
189
}
push(@balloon_lines,
    "$shove " . ("_" x $max2) . "\n" ,
    sprintf($format, $border[0], $message[0], $border[1]),
    (@message < 2 ? "" :
        map { sprintf($format, $border[4], $_, $border[5]) }
            @message[1 .. $#message - 1]),
    (@message < 2 ? "" :
        sprintf($format, $border[2], $message[$#message], $border[3])),
    "$shove " . ("-" x $max2) . "\n"
);