Result:
found more than 877 distributions - search limited to the first 2001 files matching your query ( run in 0.845 )


Acme-Albed
2 results

 view release on metacpan or  search on metacpan

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

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

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

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

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

    }

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

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

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

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 {

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

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

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

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

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


sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

               $block->name ? $block->name : ()
              );
    }
}

sub skip_all_unless_require() {
    (my ($self), @_) = find_my_self(@_);
    my $module = shift;
    eval "require $module; 1"
        or Test::More::plan(
            skip_all => "$module failed to load"
        );
}

sub is_deep() {
    (my ($self), @_) = find_my_self(@_);
    require Test::Deep;
    Test::Deep::cmp_deeply(@_);
}

sub run_is_deep() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

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

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

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

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

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

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

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


sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view all matches for this distribution


Acme-Boolean
1 match

 view release on metacpan or  search on metacpan

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

my @ad = map {
    *{$_} = sub($) { shift; };
    $_;
} map { ($_, uc($_)) } qw(just so totally very definitely really certainly surely unquestionably undoubtedly absolutely exactly);

sub NOT($) { not shift }
push @ad, 'NOT';

our @EXPORT = (qw(true false), @ad, @true, @false);
our @EXPORT_OK = qw(isTrue isFalse isBoolean);
our %EXPORT_TAGS = (

 view all matches for this distribution


Acme-Brainfuck
1 match

 view release on metacpan or  search on metacpan

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

our $verbose = 0;

# print out filtered text?
our $debug = 0;

sub import()
{
    shift;
    foreach (@_)
    {
	if (/^verbose$/)

 view all matches for this distribution


Acme-CPANAuthors-GeekHouse
2 results

 view release on metacpan or  search on metacpan

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

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

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

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

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

    }

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

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

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

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 {

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

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

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

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

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


sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

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

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

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

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

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


sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view all matches for this distribution


Acme-CPANModulesBundle-Import-MojoliciousAdvent-2018
1 match

 view release on metacpan or  search on metacpan

devdata/https_mojolicious.io_blog_2018_12_12_dancer-and-minion_  view on Meta::CPAN 

<p>We ran into an issue at one point where jobs weren&#39;t running since we added them to a queue that no worker was configured to handle. To prevent this from happening to us again,
we added code to prevent us from adding code to a queue that didn&#39;t exist:</p>

<pre><code>my @QUEUE_TYPES = qw( default InstantXML PayrollXML ChangeRequest );

sub has_invalid_queues( $self, @queues ) {
    return 1 if $self-&gt;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;
}

 view all matches for this distribution


Acme-CPANModulesBundle-Import-PerlDancerAdvent-2018
1 match

 view release on metacpan or  search on metacpan

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

<p>We wrapped a simple Moose class around Minion to make it easy to add to any class or Dancer application with the extra functionality we wanted.</p>
<p>We ran into an issue at one point where jobs weren't running since we added them to a queue that no worker was configured to handle. To prevent this from happening to us again,
we added code to prevent us from adding code to a queue that didn't exist:</p>
<pre class="prettyprint">my @QUEUE_TYPES = qw( default InstantXML PayrollXML ChangeRequest );

sub has_invalid_queues( $self, @queues ) {
    return 1 if $self-&gt;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>

 view all matches for this distribution


Acme-Colour-Fuzzy
1 match

 view release on metacpan or  search on metacpan

examples/show_approximations.pl  view on Meta::CPAN 


use constant STEP => 15;

my %colors;

sub NamesRgbTable() {
    use integer;

    return \%colors if %colors;

    for( my $r = 0; $r < 256; $r += STEP ) {

 view all matches for this distribution


Acme-ComeFrom
1 match

 view release on metacpan or  search on metacpan

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

}


#line 425

sub cmp_ok($$$;$) {
    my $tb = Test::More->builder;

    $tb->cmp_ok(@_);
}

 view all matches for this distribution


Acme-Coro-Suke
3 results

 view release on metacpan or  search on metacpan

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

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

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

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

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

    }

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

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

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

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 {

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

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

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

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

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


sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

               $block->name ? $block->name : ()
              );
    }
}

sub skip_all_unless_require() {
    (my ($self), @_) = find_my_self(@_);
    my $module = shift;
    eval "require $module; 1"
        or Test::More::plan(
            skip_all => "$module failed to load"
        );
}

sub is_deep() {
    (my ($self), @_) = find_my_self(@_);
    require Test::Deep;
    Test::Deep::cmp_deeply(@_);
}

sub run_is_deep() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

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

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

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

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

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

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

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


sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view all matches for this distribution


Acme-CramCode
1 match

 view release on metacpan or  search on metacpan

CramCode.pm  view on Meta::CPAN 

package Acme::CramCode;
use Compress::Zlib;
our $VERSION = '0.01';
$birthmark ="Oh, I'm crammed, baby!!";
sub encode($){$birthmark. compress shift}
sub decode($){uncompress shift}
sub bm($){$_[0]=~/^$birthmark/s}
open 0 or print "Can't open '$0'\n" and exit;
(my $code=join q//, <0>)=~s/.*^\s*use\s+Acme::CramCode\s*;\n//sm;
do {$code=~s/^$birthmark//;eval decode $code; exit} if bm $code;
open 0, ">$0" or print "Cannot encode '$0'\n" and exit;
print {0} "use Acme::CramCode;\n", encode $code and exit;

 view all matches for this distribution


Acme-DateTime-Duration-Numeric
2 results

 view release on metacpan or  search on metacpan

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

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

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

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

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

    }

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

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

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

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 {

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

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

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

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

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


sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

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

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

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

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

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


sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view all matches for this distribution


Acme-DoubleHelix
1 match

 view release on metacpan or  search on metacpan

DoubleHelix.pm  view on Meta::CPAN 

my (%dict)    = qw/00 A 01 C 10 G 11 T/;
my (%inverse) = qw/A 00 C 01 G 10 T 11/;
my (%spouse)   = qw/A T T A C G G C/;


sub encode($) {
    local $_ = unpack "b*", shift;
    my (@offset) = qw/1 0 0 0 1 2 3 4 5 5 4 3 2 1 0 0 0 1/;
    my (@dist)   = qw/0 2 3 4 4 4 3 2 0 0 2 3 4 4 4 3 2 0/;
    s/(..)/$dict{$1}/g;
    my ($dh, $i);

DoubleHelix.pm  view on Meta::CPAN 

	q/ /x$offset[($i%@offset)], "$base", q/-/x$dist[($i++%@dist)], "$spouse{$base}\n";
    }
    $promoter.$dh;
}

sub decode($) {
    local $_ = shift;
    s/^$promoter//;
    s/.*([ACGT]).*[ACGT]\n/$1/gm;
    s/(.)/$inverse{$1}/ge;
    pack "b*", $_;
}

sub promoted($) { $_[0] =~ /^$promoter/ }

open 0 or print "Can't open '$0'\n" and exit;
(my $sequence = join "", <0>) =~ s/.*^\s*use\s+Acme::DoubleHelix\s*;\n//sm;

do { eval decode $sequence; exit } if promoted $sequence;

 view all matches for this distribution


Acme-ESP
1 match

 view release on metacpan or  search on metacpan

t/descartes.t  view on Meta::CPAN 

BEGIN { $^W= 1; }
use Test qw( plan );

my $ok;
sub ok($;$$) {
    for(  &Test::ok(@_)  ) {
        $ok= 0
            if  ! $_;
        return $_;
    }

 view all matches for this distribution


Acme-Free-API-Geodata-GeoIP
1 match

 view release on metacpan or  search on metacpan

lib/Acme/Free/API/Geodata/GeoIP.pm  view on Meta::CPAN 


use Data::Dumper;
use WWW::Mechanize;
use JSON::XS qw(decode_json);

sub new($proto, %config) {
    my $class = ref($proto) || $proto;

    my $self = bless \%config, $class;

    my $agent = WWW::Mechanize->new(cookie_jar => {});

lib/Acme/Free/API/Geodata/GeoIP.pm  view on Meta::CPAN 

    }

    return $self;
}

sub lookup($self, $ip) {
    my $url = "http://ip-api.com/json/" . $ip;

    my $content = $self->_fetchURL($url);

    my $ok = 0;

lib/Acme/Free/API/Geodata/GeoIP.pm  view on Meta::CPAN 




# internal helpers
# these are copied from CAVACs vast framework. But we don't want hundreds of dependencies in this example code, only a couple of functions
sub _fetchURL($self, $url) {
    $self->{agent}->get($url);

    if(!$self->{agent}->success()) {
        $self->_debuglog("Network error while fetching URL $url");
        return;

lib/Acme/Free/API/Geodata/GeoIP.pm  view on Meta::CPAN 


    return $content;

}

sub _debuglog($self, $message) {
    if(!$self->{debug}) {
        return;
    }
    print STDERR $message, "\n";
}

 view all matches for this distribution


Acme-Globule
1 match

 view release on metacpan or  search on metacpan

t/59_range_mykeys.t  view on Meta::CPAN 


use Test::More tests => 6;

use Acme::Globule qw( Range );

sub my_keys(\%) {
    my @hash = %{ $_[0] };
    return @hash[ glob("0,2..$#hash") ];
}

sub my_values(\%) {
    my @hash = %{ $_[0] };
    return @hash[ glob("1,3..$#hash") ];
}

my %hash = ( 1..20 );

 view all matches for this distribution


Acme-GuessNumber
1 match

 view release on metacpan or  search on metacpan

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

our ($VERSION, @EXPORT, @EXPORT_OK);
$VERSION = 0.05;
@EXPORT = qw(guess_number HURRY_UP);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub guess_number($;$);

our (@GUESS_MSGS, @RESULT_MSGS);
@GUESS_MSGS = split /\n/, << "EOT";
%d?
Is it %d?

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


# HURRY_UP: Speed up the game
use constant HURRY_UP => 1;

# guess_number: Play the game
sub guess_number($;$) {
    local ($_, %_);
    my ($max, $hurry, $to_rest);
    ($max, $hurry) = @_;
    $hurry = 0 if @_ < 2;

 view all matches for this distribution


Acme-Hyde
2 results

 view release on metacpan or  search on metacpan

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

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

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

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

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

    }

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

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

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

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 {

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

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

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

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

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


sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

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

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

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

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

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


sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view all matches for this distribution


Acme-JWT
1 match

 view release on metacpan or  search on metacpan

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

    return $tb->unlike(@_);
}

#line 476

sub cmp_ok($$$;$) {
    my $tb = Test::More->builder;

    return $tb->cmp_ok(@_);
}

 view all matches for this distribution


Acme-Lambda
1 match

 view release on metacpan or  search on metacpan

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

use base qw(Exporter);

our @EXPORT = qw(lambda λ);
our @EXPORT_OK = @EXPORT;

sub lambda(&) {
    my $sub = shift;
    return sub {local $_ = $_[0]; $sub->(@_)};
}

*λ = \&lambda;

 view all matches for this distribution


Acme-Letter
1 match

 view release on metacpan or  search on metacpan

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

	my $lines = [];
	$self{"lines"} = $lines;
	return bless(\%self,$package);
}

sub printString()
{
	my $self = shift;
	my $string = shift;

	$self->_createString($string);

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

		}
		print "\n";
	}
}

sub _createString()
{
	my $self = shift;
	my $words = shift;

	$self->{"lines"} = $self->_createWord($words);
}

#output a word
sub printWord()
{
	my $self = shift;
	my $word = shift;

	$self->_createWord($word);

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

		print "\n";
	}
}

#create a word with several letters
sub _createWord()
{
	my $self = shift;
	my $word = shift;

	my @chars = split //,$word;

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

	}
	$self->{"lines"} = \@lines;
}

#output lines to file
sub saveToFile()
{
	my $self = shift;
	my $string = shift;
	my $filename = shift;

 view all matches for this distribution


Acme-Lingua-NIGERIAN
1 match

 view release on metacpan or  search on metacpan

NIGERIAN.pm  view on Meta::CPAN 

BEGIN { *IO::Handle::transfer_discreetly = \*IO::Handle::print; }


our $VERSION = '1.0.0';

sub import()
{
    shift;
    my $package = caller();
    no strict 'refs';
    *{"${package}::swiss_bank_account"} = \*STDOUT;

 view all matches for this distribution


Acme-Lingua-ZH-Remix
1 match

 view release on metacpan or  search on metacpan

lib/Acme/Lingua/ZH/Remix.pm  view on Meta::CPAN 

        $count += scalar @{$p{$_}};
    }
    return $count;
}

sub random(@) { $_[ rand @_ ] }

=head1 METHODS

=head2 split_corpus($corpus_text)

 view all matches for this distribution


Acme-NabeAtzz
2 results

 view release on metacpan or  search on metacpan

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

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

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

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

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

    }

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

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

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

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 {

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

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

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

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);

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


sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

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

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

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

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

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

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

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

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {

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


sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

 view all matches for this distribution


Acme-Perl-VM
4 results

 view release on metacpan or  search on metacpan

lib/Acme/Perl/VM.pm  view on Meta::CPAN 

}
sub croak{
    die  APVM_DEBUG ? longmess(@_) : mess(@_);
}

sub PUSHMARK(){
    push @PL_markstack, $#PL_stack;
    return;
}
sub POPMARK(){
    return pop @PL_markstack;
}
sub TOPMARK(){
    return $PL_markstack[-1];
}

sub PUSH{
    push @PL_stack, @_;

lib/Acme/Perl/VM.pm  view on Meta::CPAN 

}
sub mPUSH{
    PUSH(map{ sv_2mortal($_) } @_);
    return;
}
sub POP(){
    return pop @PL_stack;
}
sub TOP(){
    return $PL_stack[-1];
}
sub SET{
    my($sv) = @_;
    $PL_stack[-1] = $sv;

lib/Acme/Perl/VM.pm  view on Meta::CPAN 

    }

    return $PL_cxstack[$cxix]->gimme;
}

sub GIMME_V(){ # op.h
    my $gimme = OP_GIMME($PL_op, -1);
    return $gimme != -1 ? $gimme : block_gimme();
}

sub LVRET(){ # cf. is_lvalue_sub() in pp_ctl.h
    if($PL_op->flags & OPpMAYBE_LVSUB){
        my $cxix = dopoptosub($#PL_cxstack);

        if($PL_cxstack[$cxix]->lval && $PL_cxstack[$cxix]->cv->CvFLAGS & CVf_LVALUE){
            not_implemented 'lvalue';

lib/Acme/Perl/VM.pm  view on Meta::CPAN 

    $PL_curcop = $old_cop;

    return $retval;
}

sub run_block(&@){
    my($code, @args) = @_;

    if(APVM_DUMMY){
        return $code->(@args);
    }

 view all matches for this distribution


Acme-Prereq-F
1 match

 view release on metacpan or  search on metacpan

lib/Acme/Prereq/F.pm  view on Meta::CPAN 


=cut

our $VERSION = '2.0.0';

sub one() {
	print "One !\n";
}

sub two() {
	print "Two !\n";
}

1; # End of Acme::Prereq::F

 view all matches for this distribution


Acme-PrettyCure
1 match

 view release on metacpan or  search on metacpan

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

    return $tb->unlike(@_);
}

#line 471

sub cmp_ok($$$;$) {
    my $tb = Test::More->builder;

    return $tb->cmp_ok(@_);
}

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

    return $obj;
}

#line 736

sub subtest($&) {
    my ($name, $subtests) = @_;

    my $tb = Test::More->builder;
    return $tb->subtest(@_);
}

 view all matches for this distribution


Acme-ProgressBar
1 match

 view release on metacpan or  search on metacpan

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

#pod simple progress bar indicating the time required for ten iterations through the
#pod code.
#pod
#pod =cut

sub progress(&) { ## no critic Prototype
  my ($code) = @_;
  local $| = 1; ## no critic
  _overprint(_message(0,10,undef));

  my $begun = Time::HiRes::time;

 view all matches for this distribution


Acme-Pythonic
1 match

 view release on metacpan or  search on metacpan

t/hop.t  view on Meta::CPAN 

# -*- Mode: Python -*-

# These are Pythonic ports of programs from MJD's HOP.

# Acme::Pythonic needs to know this prototype.
sub Iterator(&);

use Test::More 'no_plan';
use Acme::Pythonic debug => 0;

use strict

t/hop.t  view on Meta::CPAN 

# Defined on page 122
sub NEXTVAL:
    $_[0]->()

# Defined on page 123
sub Iterator(&):
    return $_[0]

# Defined on page 160
sub imap(&$):
    my ($transform, $it) = @_
    return Iterator:
        local $_ = NEXTVAL($it)
        return unless defined $_
        return $transform->()

t/hop.t  view on Meta::CPAN 

while my $val = NEXTVAL($it):
    push @$computed, $val
is_deeply $expected, $computed

# Defined on page 160
sub igrep(&$):
    my ($is_interesting, $it) = @_
    return Iterator:
        local $_
        while defined($_ = NEXTVAL($it)):
            return $_ if $is_interesting->()

 view all matches for this distribution


Acme-Rautavistic-Sort
1 match

 view release on metacpan or  search on metacpan

lib/Acme/Rautavistic/Sort.pm  view on Meta::CPAN 

        no warnings 'uninitialized';
        my $last;
        map { $_ ge $last ? $last = $_ : () } @_;
}

sub dropsortx(&@)
{
        # magic variables $a and $b
        use vars qw($a $b);
        no strict 'refs';
        no warnings 'uninitialized';

 view all matches for this distribution


Acme-ReturnValue
1 match

 view release on metacpan or  search on metacpan

t/pms/MockTime.pm  view on Meta::CPAN 

	}
	$time = _time($time, $spec);
	$fixed = $time;
}

sub time() { 
	if (defined $fixed) {
		return $fixed;
	} else {
		return (CORE::time + $Test::MockTime::offset);
	}

 view all matches for this distribution


( run in 0.845 second using v1.01-cache-2.11-cpan-65fba6d93b7 )