Acme-Coro-Suke
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# 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;
}
sub _cmp ($$) {
_version($_[0]) <=> _version($_[1]);
}
inc/Module/Install/AuthorTests.pm view on Meta::CPAN
my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
# XXX: pick a default, later -- rjbs, 2008-02-24
my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
@dirs = grep { -d } @dirs;
if ($recurse) {
require File::Find;
my %test_dir;
File::Find::find(_wanted(\%test_dir), @dirs);
$self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
} else {
$self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
}
}
#line 107
1;
inc/Module/Install/Makefile.pm view on Meta::CPAN
if ( $self->tests ) {
die "tests_recursive will not work if tests are already defined";
}
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
%test_dir = ();
require File::Find;
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 @_;
# Check the current Perl version
my $perl_version = $self->perl_version;
if ( $perl_version ) {
eval "use $perl_version; 1"
inc/Module/Install/Makefile.pm view on Meta::CPAN
if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
# Merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ }
map { @$_ }
grep $_,
($self->configure_requires, $self->build_requires, $self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
inc/Module/Install/Makefile.pm view on Meta::CPAN
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "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)) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
inc/Module/Install/Metadata.pm view on Meta::CPAN
push @{$self->{values}->{$key}}, @_;
return $self;
};
}
foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
return () unless $self->{values}->{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
@{ $self->{values}->{resources} };
}
return $self->{values}->{resources}->{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
$self->resources( $key => $uri );
return 1;
};
inc/Module/Install/Metadata.pm view on Meta::CPAN
*$key = sub {
my $self = shift;
return $self->{values}->{$key} unless @_;
my @added;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @added, [ $module, $version ];
}
push @{ $self->{values}->{$key} }, @added;
return map {@$_} @added;
};
}
# Resource handling
my %lc_resource = map { $_ => 1 } qw{
homepage
license
bugtracker
repository
};
sub resources {
my $self = shift;
while ( @_ ) {
my $name = shift or last;
inc/Module/Install/Metadata.pm view on Meta::CPAN
# The user used ->feature like ->features by passing in the second
# argument as a reference. Accomodate for that.
$mods = $_[0];
} else {
$mods = \@_;
}
my $count = 0;
push @$features, (
$name => [
map {
ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
} @$mods
]
);
return @$features;
}
sub features {
my $self = shift;
inc/Module/Install/Metadata.pm view on Meta::CPAN
# Load the advisory META.yml file
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashs
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
if ( exists $val->{requires} ) {
$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
}
if ( exists $val->{build_requires} ) {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
return $meta;
}
1;
inc/Spiffy.pm view on Meta::CPAN
use Carp;
require Exporter;
our $VERSION = '0.30';
our @EXPORT = ();
our @EXPORT_BASE = qw(field const stub super);
our @EXPORT_OK = (@EXPORT_BASE, qw(id WWW XXX YYY ZZZ));
our %EXPORT_TAGS = (XXX => [qw(WWW XXX YYY ZZZ)]);
my $stack_frame = 0;
my $dump = 'yaml';
my $bases_map = {};
sub WWW; sub XXX; sub YYY; sub ZZZ;
# This line is here to convince "autouse" into believing we are autousable.
sub can {
($_[1] eq 'import' and caller()->isa('autouse'))
? \&Exporter::import # pacify autouse's equality test
: $_[0]->SUPER::can($_[1]) # normal case
}
inc/Spiffy.pm view on Meta::CPAN
} ( @{"$class\::EXPORT"},
($args->{-Base} or $args->{-base})
? @{"$class\::EXPORT_BASE"} : (),
);
my @export_ok = grep {
not defined &{"$caller_package\::$_"};
} @{"$class\::EXPORT_OK"};
# Avoid calling the expensive Exporter::export
# if there is nothing to do (optimization)
my %exportable = map { ($_, 1) } @export, @export_ok;
next unless keys %exportable;
my @export_save = @{"$class\::EXPORT"};
my @export_ok_save = @{"$class\::EXPORT_OK"};
@{"$class\::EXPORT"} = @export;
@{"$class\::EXPORT_OK"} = @export_ok;
my @list = grep {
(my $v = $_) =~ s/^[\!\:]//;
$exportable{$v} or ${"$class\::EXPORT_TAGS"}{$v};
} @export_list;
inc/Spiffy.pm view on Meta::CPAN
$_ = $data;
my @my_subs;
s[^(sub\s+\w+\s+\{)(.*\n)]
[${1}my \$self = shift;$2]gm;
s[^(sub\s+\w+)\s*\(\s*\)(\s+\{.*\n)]
[${1}${2}]gm;
s[^my\s+sub\s+(\w+)(\s+\{)(.*)((?s:.*?\n))\}\n]
[push @my_subs, $1; "\$$1 = sub$2my \$self = shift;$3$4\};\n"]gem;
my $preclare = '';
if (@my_subs) {
$preclare = join ',', map "\$$_", @my_subs;
$preclare = "my($preclare);";
}
$_ = "use strict;use warnings;$preclare${_};1;\n$end";
if ($filter_dump) { print; exit }
if ($filter_save) { $filter_result = $_; $_ = $filter_result; }
$done = 1;
}
);
}
sub base {
push @_, -base;
goto &import;
}
sub all_my_bases {
my $class = shift;
return $bases_map->{$class}
if defined $bases_map->{$class};
my @bases = ($class);
no strict 'refs';
for my $base_class (@{"${class}::ISA"}) {
push @bases, @{all_my_bases($base_class)};
}
my $used = {};
$bases_map->{$class} = [grep {not $used->{$_}++} @bases];
}
my %code = (
sub_start =>
"sub {\n",
set_default =>
" \$_[0]->{%s} = %s\n unless exists \$_[0]->{%s};\n",
init =>
" return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
" unless \$#_ > 0 or defined \$_[0]->{%s};\n",
inc/Spiffy.pm view on Meta::CPAN
sub {
require Carp;
Carp::confess
"Method $field in package $package must be subclassed";
}
}
sub parse_arguments {
my $class = shift;
my ($args, @values) = ({}, ());
my %booleans = map { ($_, 1) } $class->boolean_arguments;
my %pairs = map { ($_, 1) } $class->paired_arguments;
while (@_) {
my $elem = shift;
if (defined $elem and defined $booleans{$elem}) {
$args->{$elem} = (@_ and $_[0] =~ /^[01]$/)
? shift
: 1;
}
elsif (defined $elem and defined $pairs{$elem} and @_) {
$args->{$elem} = shift;
}
inc/Spiffy.pm view on Meta::CPAN
@{"$target_class\::ISA"} = ($pseudo_class);
for (keys %methods) {
*{"$pseudo_class\::$_"} = $methods{$_};
}
}
sub spiffy_mixin_methods {
my $mixin_class = shift;
no strict 'refs';
my %methods = spiffy_all_methods($mixin_class);
map {
$methods{$_}
? ($_, \ &{"$methods{$_}\::$_"})
: ($_, \ &{"$mixin_class\::$_"})
} @_
? (get_roles($mixin_class, @_))
: (keys %methods);
}
sub get_roles {
my $mixin_class = shift;
my @roles = @_;
while (grep /^!*:/, @roles) {
@roles = map {
s/!!//g;
/^!:(.*)/ ? do {
my $m = "_role_$1";
map("!$_", $mixin_class->$m);
} :
/^:(.*)/ ? do {
my $m = "_role_$1";
($mixin_class->$m);
} :
($_)
} @roles;
}
if (@roles and $roles[0] =~ /^!/) {
my %methods = spiffy_all_methods($mixin_class);
inc/Spiffy.pm view on Meta::CPAN
if /^!(.*)/;
$roles{$_} = 1;
}
keys %roles;
}
sub spiffy_all_methods {
no strict 'refs';
my $class = shift;
return if $class eq 'Spiffy';
my %methods = map {
($_, $class)
} grep {
defined &{"$class\::$_"} and not /^_/
} keys %{"$class\::"};
my %super_methods;
%super_methods = spiffy_all_methods(${"$class\::ISA"}[0])
if @{"$class\::ISA"};
%{{%super_methods, %methods}};
}
inc/Test/Base.pm view on Meta::CPAN
tie_output no_diag_on_only
find_my_self default_object
croak carp cluck confess
));
field '_spec_file';
field '_spec_string';
field _filters => [qw(norm trim)];
field _filters_map => {};
field spec =>
-init => '$self->_spec_init';
field block_list =>
-init => '$self->_block_list_init';
field _next_list => [];
field block_delim =>
-init => '$self->block_delim_default';
field data_delim =>
-init => '$self->data_delim_default';
field _filters_delay => 0;
inc/Test/Base.pm view on Meta::CPAN
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
my $filters = $self->_filters;
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
inc/Test/Base.pm view on Meta::CPAN
my $name = $1;
my @parts = split /^\Q${dd}\E +\(?(\w+)\)? *(.*)?\n/m, $hunk;
my $description = shift @parts;
$description ||= '';
unless ($description =~ /\S/) {
$description = $name;
}
$description =~ s/\s*\z//;
$block->set_value(description => $description);
my $section_map = {};
my $section_order = [];
while (@parts) {
my ($type, $filters, $value) = splice(@parts, 0, 3);
$self->_check_reserved($type);
$value = '' unless defined $value;
$filters = '' unless defined $filters;
if ($filters =~ /:(\s|\z)/) {
croak "Extra lines not allowed in '$type' section"
if $value =~ /\S/;
($filters, $value) = split /\s*:(?:\s+|\z)/, $filters, 2;
$value = '' unless defined $value;
$value =~ s/^\s*(.*?)\s*$/$1/;
}
$section_map->{$type} = {
filters => $filters,
};
push @$section_order, $type;
$block->set_value($type, $value);
}
$block->set_value(name => $name);
$block->set_value(_section_map => $section_map);
$block->set_value(_section_order => $section_order);
return $block;
}
sub _spec_init {
return $self->_spec_string
if $self->_spec_string;
local $/;
my $spec;
if (my $spec_file = $self->_spec_file) {
inc/Test/Base.pm view on Meta::CPAN
sub set_value {
no strict 'refs';
my $accessor = shift;
block_accessor $accessor
unless defined &$accessor;
$self->{$accessor} = [@_];
}
sub run_filters {
my $map = $self->_section_map;
my $order = $self->_section_order;
Carp::croak "Attempt to filter a block twice"
if $self->is_filtered;
for my $type (@$order) {
my $filters = $map->{$type}{filters};
my @value = $self->$type;
$self->original_values->{$type} = $value[0];
for my $filter ($self->_get_filters($type, $filters)) {
$Test::Base::Filter::arguments =
$filter =~ s/=(.*)$// ? $1 : undef;
my $function = "main::$filter";
no strict 'refs';
if (defined &$function) {
local $_ =
(@value == 1 and not defined($value[0])) ? undef :
inc/Test/Base.pm view on Meta::CPAN
}
}
$self->is_filtered(1);
}
sub _get_filters {
my $type = shift;
my $string = shift || '';
$string =~ s/\s*(.*?)\s*/$1/;
my @filters = ();
my $map_filters = $self->blocks_object->_filters_map->{$type} || [];
$map_filters = [ $map_filters ] unless ref $map_filters;
my @append = ();
for (
@{$self->blocks_object->_filters},
@$map_filters,
split(/\s+/, $string),
) {
my $filter = $_;
last unless length $filter;
if ($filter =~ s/^-//) {
@filters = grep { $_ ne $filter } @filters;
}
elsif ($filter =~ s/^\+//) {
push @append, $filter;
}
else {
push @filters, $filter;
}
}
return @filters, @append;
}
{
%$reserved_section_names = map {
($_, 1);
} keys(%Test::Base::Block::), qw( new DESTROY );
}
__DATA__
=encoding utf8
#line 1376
inc/Test/Base/Filter.pm view on Meta::CPAN
if (ref $_[0] eq 'ARRAY') {
for my $aref (@_) {
@$aref = $self->_apply_deepest($method, @$aref);
}
return @_;
}
$self->$method(@_);
}
sub _split_array {
map {
[$self->split($_)];
} @_;
}
sub _peel_deepest {
return () unless @_;
if (ref $_[0] eq 'ARRAY') {
if (ref $_[0]->[0] eq 'ARRAY') {
for my $aref (@_) {
@$aref = $self->_peel_deepest(@$aref);
}
return @_;
}
return map { $_->[0] } @_;
}
return @_;
}
#===============================================================================
# these filters work on the leaves of nested arrays
#===============================================================================
sub Join { $self->_peel_deepest($self->_apply_deepest(join => @_)) }
sub Reverse { $self->_apply_deepest(reverse => @_) }
sub Split { $self->_apply_deepest(_split_array => @_) }
sub Sort { $self->_apply_deepest(sort => @_) }
sub append {
my $suffix = $self->current_arguments;
map { $_ . $suffix } @_;
}
sub array {
return [@_];
}
sub base64_decode {
$self->assert_scalar(@_);
require MIME::Base64;
MIME::Base64::decode_base64(shift);
}
sub base64_encode {
$self->assert_scalar(@_);
require MIME::Base64;
MIME::Base64::encode_base64(shift);
}
sub chomp {
map { CORE::chomp; $_ } @_;
}
sub chop {
map { CORE::chop; $_ } @_;
}
sub dumper {
no warnings 'once';
require Data::Dumper;
local $Data::Dumper::Sortkeys = 1;
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Terse = 1;
Data::Dumper::Dumper(@_);
}
inc/Test/Base/Filter.pm view on Meta::CPAN
close $execution;
unlink($tmpfile)
or die "Couldn't unlink $tmpfile: $!\n";
return $output;
}
sub flatten {
$self->assert_scalar(@_);
my $ref = shift;
if (ref($ref) eq 'HASH') {
return map {
($_, $ref->{$_});
} sort keys %$ref;
}
if (ref($ref) eq 'ARRAY') {
return @$ref;
}
die "Can only flatten a hash or array ref";
}
sub get_url {
inc/Test/Base/Filter.pm view on Meta::CPAN
$self->assert_scalar(@_);
my $text = shift;
$text = '' unless defined $text;
$text =~ s/\015\012/\n/g;
$text =~ s/\r/\n/g;
return $text;
}
sub prepend {
my $prefix = $self->current_arguments;
map { $prefix . $_ } @_;
}
sub read_file {
$self->assert_scalar(@_);
my $file = shift;
CORE::chomp $file;
open my $fh, $file
or die "Can't open '$file' for input:\n$!";
CORE::join '', <$fh>;
}
inc/Test/Base/Filter.pm view on Meta::CPAN
use warnings;
...
}
sub tail {
my $size = $self->current_arguments || 1;
return splice(@_, @_ - $size, $size);
}
sub trim {
map {
s/\A([ \t]*\n)+//;
s/(?<=\n)\s*\z//g;
$_;
} @_;
}
sub unchomp {
map { $_ . "\n" } @_;
}
sub write_file {
my $file = $self->current_arguments
or die "No file specified for write_file filter";
if ($file =~ /(.*)[\\\/]/) {
my $dir = $1;
if (not -e $dir) {
require File::Path;
File::Path::mkpath($dir)
inc/Test/Builder.pm view on Meta::CPAN
sub unlike {
my( $self, $this, $regex, $name ) = @_;
local $Level = $Level + 1;
return $self->_regex_ok( $this, $regex, '!~', $name );
}
#line 1046
my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
sub cmp_ok {
my( $self, $got, $type, $expect, $name ) = @_;
my $test;
my $error;
{
## no critic (BuiltinFunctions::ProhibitStringyEval)
local( $@, $!, $SIG{__DIE__} ); # isolate eval
inc/Test/Builder.pm view on Meta::CPAN
my( $self, $fh, @msgs ) = @_;
return if $self->no_diag;
return unless @msgs;
# Prevent printing headers when compiling (i.e. -c)
return if $^C;
# Smash args together like print does.
# Convert undef to 'undef' so its readable.
my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
# Escape the beginning, _print will take care of the rest.
$msg =~ s/^/# /;
local $Level = $Level + 1;
$self->_print_to_fh( $fh, $msg );
return 0;
}
#line 1644
sub explain {
my $self = shift;
return map {
ref $_
? do {
$self->_try(sub { require Data::Dumper }, die_on_fail => 1);
my $dumper = Data::Dumper->new( [$_] );
$dumper->Indent(1)->Terse(1);
$dumper->Sortkeys(1) if $dumper->can("Sortkeys");
$dumper->Dump;
}
: $_
inc/Test/Builder.pm view on Meta::CPAN
}
sub _copy_io_layers {
my( $self, $src, $dst ) = @_;
$self->_try(
sub {
require PerlIO;
my @src_layers = PerlIO::get_layers($src);
binmode $dst, join " ", map ":$_", @src_layers if @src_layers;
}
);
return;
}
#line 1857
sub reset_outputs {
my $self = shift;
inc/Test/Builder.pm view on Meta::CPAN
return $self->{Is_Passing};
}
#line 1993
sub summary {
my($self) = shift;
return map { $_->{'ok'} } @{ $self->{Test_Results} };
}
#line 2048
sub details {
my $self = shift;
return @{ $self->{Test_Results} };
}
#line 2077
inc/Test/More.pm view on Meta::CPAN
my @nok = ();
foreach my $method (@methods) {
$tb->_try( sub { $proto->can($method) } ) or push @nok, $method;
}
my $name = (@methods == 1) ? "$class->can('$methods[0]')" :
"$class->can(...)" ;
my $ok = $tb->ok( !@nok, $name );
$tb->diag( map " $class->can('$_') failed\n", @nok );
return $ok;
}
#line 572
sub isa_ok ($$;$) {
my( $object, $class, $obj_name ) = @_;
my $tb = Test::More->builder;
xt/01_podspell.t view on Meta::CPAN
use Test::More;
eval q{ use Test::Spelling };
plan skip_all => "Test::Spelling is not installed." if $@;
add_stopwords(map { split /[\s\:\-]/ } <DATA>);
$ENV{LANG} = 'C';
all_pod_files_spelling_ok('lib');
__DATA__
Masahiro Chiba
Acme::Coro::Suke
tokuhirom
AAJKLFJEF
GMAIL
COM
Tatsuhiko
( run in 0.372 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )