Acme-Albed
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
# different versions of modules.
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '0.91';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2009 Adam Kennedy.
inc/Module/Install/Metadata.pm view on Meta::CPAN
artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
lgpl => 'http://opensource.org/licenses/lgpl-license.php',
lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
bsd => 'http://opensource.org/licenses/bsd-license.php',
gpl => 'http://opensource.org/licenses/gpl-license.php',
gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
mit => 'http://opensource.org/licenses/mit-license.php',
mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
open_source => undef,
unrestricted => undef,
restrictive => undef,
unknown => undef,
);
sub license {
my $self = shift;
return $self->{values}->{license} unless @_;
my $license = shift or die(
'Did not provide a value to license()'
);
$self->{values}->{license} = $license;
inc/Module/Install/Metadata.pm view on Meta::CPAN
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
# We need Parse::CPAN::Meta to load the file
unless ( eval { require Parse::CPAN::Meta; 1; } ) {
return undef;
}
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
my $perl = delete $val->{perl_version};
if ( $perl ) {
$val->{requires} ||= [];
my $requires = $val->{requires};
# Canonize to three-dot version after Perl 5.6
inc/Spiffy.pm view on Meta::CPAN
}
return wantarray ? ($args, @values) : $args;
}
sub boolean_arguments { () }
sub paired_arguments { () }
# get a unique id for any node
sub id {
if (not ref $_[0]) {
return 'undef' if not defined $_[0];
\$_[0] =~ /\((\w+)\)$/o or die;
return "$1-S";
}
require overload;
overload::StrVal($_[0]) =~ /\((\w+)\)$/o or die;
return $1;
}
#===============================================================================
# It's super, man.
inc/Test/Base.pm view on Meta::CPAN
unless $block->is_filtered;
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
}
my $block = shift @$list;
if (defined $block and not $block->is_filtered) {
$block->run_filters;
}
return $block;
}
sub first_block() {
inc/Test/Base.pm view on Meta::CPAN
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 :
join '', @value;
my $old = $_;
@value = &$function(@value);
if (not(@value) or
@value == 1 and defined($value[0]) and $value[0] =~ /\A(\d+|)\z/
) {
if ($value[0] && $_ eq $old) {
Test::Base::diag("Filters returning numbers are supposed to do munging \$_: your filter '$function' apparently doesn't.");
}
@value = ($_);
inc/Test/Base/Filter.pm view on Meta::CPAN
# This is the default class for handling Test::Base data filtering.
#===============================================================================
package Test::Base::Filter;
use Spiffy -Base;
use Spiffy ':XXX';
field 'current_block';
our $arguments;
sub current_arguments {
return undef unless defined $arguments;
my $args = $arguments;
$args =~ s/(\\s)/ /g;
$args =~ s/(\\[a-z])/'"' . $1 . '"'/gee;
return $args;
}
sub assert_scalar {
return if @_ == 1;
require Carp;
my $filter = (caller(1))[3];
inc/Test/Builder.pm view on Meta::CPAN
return unless $self->parent;
if( $self->{Child_Name} ) {
$self->croak("Can't call finalize() with child ($self->{Child_Name}) active");
}
$self->_ending;
# XXX This will only be necessary for TAP envelopes (we think)
#$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" );
my $ok = 1;
$self->parent->{Child_Name} = undef;
if ( $self->{Skip_All} ) {
$self->parent->skip($self->{Skip_All});
}
elsif ( not @{ $self->{Test_Results} } ) {
$self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name );
}
else {
$self->parent->ok( $self->is_passing, $self->name );
}
$? = $self->{Child_Error};
inc/Test/Builder.pm view on Meta::CPAN
$Level = 1;
$self->{Name} = $0;
$self->is_passing(1);
$self->{Ending} = 0;
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
$self->{Have_Output_Plan} = 0;
$self->{Original_Pid} = $$;
$self->{Child_Name} = undef;
$self->{Indent} ||= '';
share( $self->{Curr_Test} );
$self->{Curr_Test} = 0;
$self->{Test_Results} = &share( [] );
$self->{Exported_To} = undef;
$self->{Expected_Tests} = 0;
$self->{Skip_All} = 0;
$self->{Use_Nums} = 1;
$self->{No_Header} = 0;
$self->{No_Ending} = 0;
$self->{Todo} = undef;
$self->{Todo_Stack} = [];
$self->{Start_Todo} = 0;
$self->{Opened_Testhandles} = 0;
$self->_dup_stdhandles;
return;
}
#line 414
inc/Test/Builder.pm view on Meta::CPAN
sub _plan_tests {
my($self, $arg) = @_;
if($arg) {
local $Level = $Level + 1;
return $self->expected_tests($arg);
}
elsif( !defined $arg ) {
$self->croak("Got an undefined number of tests");
}
else {
$self->croak("You said to run 0 tests");
}
return;
}
#line 470
inc/Test/Builder.pm view on Meta::CPAN
}
#line 630
sub has_plan {
my $self = shift;
return( $self->{Expected_Tests} ) if $self->{Expected_Tests};
return('no_plan') if $self->{No_Plan};
return(undef);
}
#line 647
sub skip_all {
my( $self, $reason ) = @_;
$self->{Skip_All} = $self->parent ? $reason : 1;
$self->_output_plan(0, "SKIP", $reason) unless $self->no_header;
inc/Test/Builder.pm view on Meta::CPAN
$self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result;
$out .= "\n";
$self->_print($out);
unless($test) {
my $msg = $self->in_todo ? "Failed (TODO)" : "Failed";
$self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE};
my( undef, $file, $line ) = $self->caller;
if( defined $name ) {
$self->diag(qq[ $msg test '$name'\n]);
$self->diag(qq[ at $file line $line.\n]);
}
else {
$self->diag(qq[ $msg test at $file line $line.\n]);
}
}
$self->is_passing(0) unless $test || $self->in_todo;
inc/Test/Builder.pm view on Meta::CPAN
#line 876
sub is_eq {
my( $self, $got, $expect, $name ) = @_;
local $Level = $Level + 1;
$self->_unoverload_str( \$got, \$expect );
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok( $test, $name );
$self->_is_diag( $got, 'eq', $expect ) unless $test;
return $test;
}
return $self->cmp_ok( $got, 'eq', $expect, $name );
}
sub is_num {
my( $self, $got, $expect, $name ) = @_;
local $Level = $Level + 1;
$self->_unoverload_num( \$got, \$expect );
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok( $test, $name );
$self->_is_diag( $got, '==', $expect ) unless $test;
return $test;
}
return $self->cmp_ok( $got, '==', $expect, $name );
}
inc/Test/Builder.pm view on Meta::CPAN
if( $type eq 'eq' or $type eq 'ne' ) {
# quote and force string context
$$val = "'$$val'";
}
else {
# force numeric context
$self->_unoverload_num($val);
}
}
else {
$$val = 'undef';
}
return;
}
sub _is_diag {
my( $self, $got, $type, $expect ) = @_;
$self->_diag_fmt( $type, $_ ) for \$got, \$expect;
inc/Test/Builder.pm view on Meta::CPAN
DIAGNOSTIC
}
#line 973
sub isnt_eq {
my( $self, $got, $dont_expect, $name ) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok( $test, $name );
$self->_isnt_diag( $got, 'ne' ) unless $test;
return $test;
}
return $self->cmp_ok( $got, 'ne', $dont_expect, $name );
}
sub isnt_num {
my( $self, $got, $dont_expect, $name ) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok( $test, $name );
$self->_isnt_diag( $got, '!=' ) unless $test;
return $test;
}
return $self->cmp_ok( $got, '!=', $dont_expect, $name );
}
inc/Test/Builder.pm view on Meta::CPAN
else {
$self->_cmp_diag( $got, $type, $expect );
}
}
return $ok;
}
sub _cmp_diag {
my( $self, $got, $type, $expect ) = @_;
$got = defined $got ? "'$got'" : 'undef';
$expect = defined $expect ? "'$expect'" : 'undef';
local $Level = $Level + 1;
return $self->diag(<<"DIAGNOSTIC");
$got
$type
$expect
DIAGNOSTIC
}
sub _caller_context {
inc/Test/Builder.pm view on Meta::CPAN
$self->_print($out);
return 1;
}
#line 1293
sub maybe_regex {
my( $self, $regex ) = @_;
my $usable_regex = undef;
return $usable_regex unless defined $regex;
my( $re, $opts );
# Check for qr/foo/
if( _is_qr($regex) ) {
$usable_regex = $regex;
}
# Check for '/foo/' or 'm,foo,'
elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
)
{
$usable_regex = length $opts ? "(?$opts)$re" : $re;
}
return $usable_regex;
}
sub _is_qr {
my $regex = shift;
inc/Test/Builder.pm view on Meta::CPAN
$test = eval $context . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
$test = !$test if $cmp eq '!~';
local $Level = $Level + 1;
$ok = $self->ok( $test, $name );
}
unless($ok) {
$this = defined $this ? "'$this'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
local $Level = $Level + 1;
$self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex );
%s
%13s '%s'
DIAGNOSTIC
}
inc/Test/Builder.pm view on Meta::CPAN
sub _print_comment {
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;
}
inc/Test/Builder.pm view on Meta::CPAN
sub _print_to_fh {
my( $self, $fh, @msgs ) = @_;
# Prevent printing headers when only compiling. Mostly for when
# tests are deparsed with B::Deparse
return if $^C;
my $msg = join '', @msgs;
local( $\, $", $, ) = ( undef, ' ', '' );
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
$msg =~ s{\n(?!\z)}{\n# }sg;
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\z/;
return print $fh $self->_indent, $msg;
}
inc/Test/Builder.pm view on Meta::CPAN
$self->{Curr_Test} = $num;
# If the test counter is being pushed forward fill in the details.
my $test_results = $self->{Test_Results};
if( $num > @$test_results ) {
my $start = @$test_results ? @$test_results : 0;
for( $start .. $num - 1 ) {
$test_results->[$_] = &share(
{
'ok' => 1,
actual_ok => undef,
reason => 'incrementing test number',
type => 'unknown',
name => undef
}
);
}
}
# If backward, wipe history. Its their funeral.
elsif( $num < @$test_results ) {
$#{$test_results} = $num - 1;
}
}
return $self->{Curr_Test};
inc/Test/More.pm view on Meta::CPAN
sub _eval {
my( $code, @args ) = @_;
# Work around oddities surrounding resetting of $@ by immediately
# storing it.
my( $sigdie, $eval_result, $eval_error );
{
local( $@, $!, $SIG{__DIE__} ); # isolate eval
$eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval)
$eval_error = $@;
$sigdie = $SIG{__DIE__} || undef;
}
# make sure that $code got a chance to set $SIG{__DIE__}
$SIG{__DIE__} = $sigdie if defined $sigdie;
return( $eval_result, $eval_error );
}
#line 875
sub require_ok ($) {
inc/Test/More.pm view on Meta::CPAN
my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ];
my @vars = ();
( $vars[0] = $var ) =~ s/\$FOO/ \$got/;
( $vars[1] = $var ) =~ s/\$FOO/\$expected/;
my $out = "Structures begin differing at:\n";
foreach my $idx ( 0 .. $#vals ) {
my $val = $vals[$idx];
$vals[$idx]
= !defined $val ? 'undef'
: _dne($val) ? "Does not exist"
: ref $val ? "$val"
: "'$val'";
}
$out .= "$vars[0] = $vals[0]\n";
$out .= "$vars[1] = $vals[1]\n";
$out =~ s/^/ /msg;
return $out;
inc/Test/More.pm view on Meta::CPAN
my $tb = Test::More->builder;
my $ok = 0;
# Effectively turn %Refs_Seen into a stack. This avoids picking up
# the same referenced used twice (such as [\$a, \$a]) to be considered
# circular.
local %Refs_Seen = %Refs_Seen;
{
# Quiet uninitialized value warnings when comparing undefs.
no warnings 'uninitialized';
$tb->_unoverload_str( \$e1, \$e2 );
# Either they're both references or both not.
my $same_ref = !( !ref $e1 xor !ref $e2 );
my $not_ref = ( !ref $e1 and !ref $e2 );
if( defined $e1 xor defined $e2 ) {
$ok = 0;
t/01_dict.t view on Meta::CPAN
# die Dumper $dic;
for my $key ( keys %$dic ) {
my @char_ja = split //, $dic->{$key}->{before};
my @char_al = split //, $dic->{$key}->{after};
foreach my $i ( 0 .. $#char_ja ) {
is( $albed->to_albed( $char_ja[$i] ), $char_al[$i] );
is( $albed->from_albed( $char_al[$i] ), $char_ja[$i] );
}
}
# undef
is( $albed->to_albed( undef ), undef );
is( $albed->from_albed( undef ), undef );
# \t\s\n
is( $albed->to_albed(" "), " " );
is( $albed->to_albed(" "), " " );
is(
$albed->to_albed( "
" ),
"
"
);
( run in 1.893 second using v1.01-cache-2.11-cpan-d80b1682f3f )