Acme-DateTime-Duration-Numeric
7 results

 view release on metacpan or  search on metacpan

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->build_requires, $self->requires) );

    # merge both kinds of requires into prereq_pm
    my $subdirs = ($args->{DIR} ||= []);
    if ($self->bundles) {
        foreach my $bundle (@{ $self->bundles }) {
            my ($file, $dir) = @$bundle;
            push @$subdirs, $dir if -d $dir;
            delete $prereq->{$file};
        }
    }

    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";
    }

    my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
    if ($self->admin->preop) {
        $args{dist} = $self->admin->preop;
    }

    my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
    $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
}

sub fix_up_makefile {
    my $self          = shift;

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;
}

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

    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) {
                $_ = join '', @value;
                @value = &$function(@value);

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__

#line 1298

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 

sub norm {
    $self->assert_scalar(@_);
    my $text = shift || '';
    $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 

    my($self, $this, $regex, $name) = @_;

    local $Level = $Level + 1;
    $self->_regex_ok($this, $regex, '!~', $name);
}


#line 685


my %numeric_cmps = map { ($_, 1) } 
                       ("<",  "<=", ">",  ">=", "==", "!=", "<=>");

sub cmp_ok {
    my($self, $got, $type, $expect, $name) = @_;

    # Treat overloaded objects as numbers if we're asked to do a
    # numeric comparison.
    my $unoverload = $numeric_cmps{$type} ? '_unoverload_num'
                                          : '_unoverload_str';

inc/Test/Builder.pm  view on Meta::CPAN 

    my($self, @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 each line with a #.
    $msg =~ s/^/# /gm;

    # Stick a newline on the end if it needs it.
    $msg .= "\n" unless $msg =~ /\n\Z/;

    local $Level = $Level + 1;
    $self->_print_diag($msg);

inc/Test/Builder.pm  view on Meta::CPAN 

    }
    return $self->{Curr_Test};
}


#line 1489

sub summary {
    my($self) = shift;

    return map { $_->{'ok'} } @{ $self->{Test_Results} };
}

#line 1544

sub details {
    my $self = shift;
    return @{ $self->{Test_Results} };
}

#line 1569

inc/Test/More.pm  view on Meta::CPAN 

    foreach my $method (@methods) {
        $tb->_try(sub { $proto->can($method) }) or push @nok, $method;
    }

    my $name;
    $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 523

sub isa_ok ($$;$) {
    my($object, $class, $obj_name) = @_;
    my $tb = Test::More->builder;



( run in 1.086 second using v1.01-cache-2.11-cpan-49f99fa48dc )