view release on metacpan or  search on metacpan

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

        ok $actual eq $expected, $name;
        diag 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);

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

t/taint.t  view on Meta::CPAN

    ? ( skip_all => 'No taint support' ) : ( tests => 2 );
use Module::Metadata;
use Carp 'croak';

# stolen liberally from Class-Tiny/t/lib/TestUtils.pm - thanks xdg!
sub exception(&) {
    my $code = shift;
    my $success = eval { $code->(); 1 };
    my $err = $@;
    return undef if $success;   # original returned ''
    croak "Execution died, but the error was lost" unless $@;

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

t/lib/Unrandom.pm  view on Meta::CPAN

*CORE::GLOBAL::rand = sub { $randhook ? $randhook->( $_[0] ) : rand @_ };

use constant VALUE => 0;
use constant BELOW => 1;

sub unrandomly(&)
{
   my $code = shift;

   my @rands;
   my $randidx;

 view release on metacpan or  search on metacpan

t/TestWSP.pm  view on Meta::CPAN

use Net::EmptyPort qw/empty_port/;

use Exporter qw(import);
our @EXPORT_OK = qw(test_wsp);

sub test_wsp(&$;@) {
    my ($code, $app_class, $responder_class) = @_;

    my $rpc_port = empty_port;
    my $rpc_url  = "http://127.0.0.1:$rpc_port/rpc/";
    local $ENV{T_TestWSP_RPC_URL} = $rpc_url;

 view release on metacpan or  search on metacpan

lib/MongoX.pm  view on Meta::CPAN

sub add_connection { MongoX::Context::add_connection(@_) }

sub boot { MongoX::Context::boot(@_) }


sub with_context(&@) { MongoX::Context::with_context(@_) }


sub for_dbs(&@) { MongoX::Context::for_dbs(shift,@_) };


sub for_connections(&@) { MongoX::Context::for_connections(shift,@_) };


sub for_collections(&@) { MongoX::Context::for_collections(shift,@_) };

sub import {
    my ( $class,   %options ) = @_;
    $class->export_to_level( 1, $class, @EXPORT );
    boot %options if %options;

 view release on metacpan or  search on metacpan

lib/Mongoose/Cursor.pm  view on Meta::CPAN

sub count {
    my $self = shift;
    $self->_class->count($self->_query->filter);
}

sub each(&) {
    my ( $self, $cb ) = @_;
    while( my $r = $self->next ) { last unless defined $cb->($r) }
}

sub hash_on {

 view release on metacpan or  search on metacpan

lib/MooX/Cmd/Tester.pm  view on Meta::CPAN

    $rv;
}

## no critic qw(ProhibitSubroutinePrototypes)
sub _capture_merged(&)
{
    my $code = shift;
    my ($stdout, $stderr, $merged, $ok);
    if ($^O eq 'MSWin32')
    {

 view release on metacpan or  search on metacpan

lib/MooX/Role/Parameterized.pm  view on Meta::CPAN

    }

    Moo::Role->apply_roles_to_package( $target, $role );
}

sub role(&) {    ##no critic (Subroutines::ProhibitSubroutinePrototypes)
    my $package = (caller)[0];

    $INFO{$package} ||= { is_role => 1 };

    croak "role subroutine called multiple times on '$package'"

 view release on metacpan or  search on metacpan

lib/MooseX/App.pm  view on Meta::CPAN

    };

    return MooseX::App::Exporter->process_init_meta(%args);
}

sub app_command_name(&) {
    my ( $meta, $namesub ) = @_;
    return $meta->app_command_name($namesub);
}

sub app_command_register(%) {

 view release on metacpan or  search on metacpan

lib/MooseX/Contract.pm  view on Meta::CPAN

=cut

our @CARP_NOT = qw(Class::MOP::Method::Wrapped);

sub assert(&;$);
sub void() { return assert { shift; @_ == 0 } "too many values (expected 0)" }

sub invariant {
	my $caller = shift;
	my %packages = map { $_ => 1 } ($caller, grep { ! ref($_) } @_);

lib/MooseX/Contract.pm  view on Meta::CPAN

	} else {
		croak "invalid parameter to accepts: $returns";
	}
}

sub check(&) { return @_ };

sub with_context {
	my %args = @_;
	if(!exists($args{pre}) || !exists($args{post})){
		croak "both 'pre' and 'post' clauses must be specified when using context";

lib/MooseX/Contract.pm  view on Meta::CPAN

		pre => sub { $context = $args{pre}->(@_) },
		post => sub { $args{post}->( $context, @_ ) }
	);
}

sub assert(&;$) {
	my($code, $message) = @_;
	$message ||= "assertion failed";
	return sub {
		$code->(@_) or croak $message;
	}

 view release on metacpan or  search on metacpan

lib/MooseX/Has/Sugar/Saccharin.pm  view on Meta::CPAN

## no critic (ProhibitBuiltinHomonyms)
sub default(&) {
  my $code = shift;
  return (
    'default',
    sub {
      my $self = $_[0];

lib/MooseX/Has/Sugar/Saccharin.pm  view on Meta::CPAN

sub trigger(&) {
  my $code = shift;
  return (
    'trigger',
    sub {
      my $self = $_[0];

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

lib/Music/Chord/Positions.pm  view on Meta::CPAN

#
# SUBROUTINES

# TODO move back to List::MoreUtils if that module is fixed up or some
# replacement with fewer open critical bugs is written.
sub all(&@) {
  my $test = shift;
  for (@_) {
    return 0 unless &$test;
  }
  return 1;

 view release on metacpan or  search on metacpan

t/mitm.t  view on Meta::CPAN

$SIG{TERM}=\&done;
$SIG{ALRM}=\&abort;
$SIG{INT}=\&abort;
$SIG{CLD} = "IGNORE";

sub spawn(&)
{
  my $block=shift;
  my $pid=fork();
  #printf "alarm reset %u/%d\n",$$,alarm(10);
  if(!defined $pid){

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

lib/Nasm/X86.pm  view on Meta::CPAN

   }
 }

#D1 Structured Programming                                                      # Structured programming constructs

sub If(&;&)                                                                     # If
 {my ($then, $else) = @_;                                                       # Then - required , else - optional
  @_ >= 1 or confess;
  if (@_ == 1)                                                                  # No else
   {Comment "if then";
    my $end = Label;

lib/Nasm/X86.pm  view on Meta::CPAN

    &$else;
    SetLabel  $endIf;
   }
 }

sub For(&$$$)                                                                   # For
 {my ($body, $register, $limit, $increment) = @_;                               # Body, register, limit on loop, increment
  @_ == 4 or confess;
  Comment "For $register $limit";
  my $start = Label;
  my $end   = Label;

lib/Nasm/X86.pm  view on Meta::CPAN

   }
  Jmp $start;
  SetLabel $end;
 }

sub S(&%)                                                                       # Create a sub with optional parameters name=> the name of the subroutine so it can be reused rather than regenerated, comment=> a comment describing the sub
 {my ($body, %options) = @_;                                                    # Body, options.
  @_ >= 1 or confess;
  my $name    = $options{name};                                                 # Optional name for subroutine reuse
  my $comment = $options{comment};                                              # Optional comment
  Comment "Subroutine " .($comment//'');

 view release on metacpan or  search on metacpan

lib/NestedMap.pm  view on Meta::CPAN

This module is free-as-in-speech software, and may be used, distributed,
and modified under the same terms as Perl itself.

=cut

sub nestedmap(&@) {
    my $f = shift;
    map {
        local @NestedMap::stack = ($_, @NestedMap::stack);
        $f->($_);
    } @_

 view release on metacpan or  search on metacpan

t/02-exceptions.t  view on Meta::CPAN

use Test::More tests => 62;
use mocked [ 'LWP::UserAgent', 't/mock' ];
use Net::API::RPX;
use Data::Dump qw( dump );

sub capture(&) {
  my ($code) = shift;
  my ( $result, $evalerror ) = ( 'fail', );
  local $@;
  eval { $code->(); $result = 'test_success' };
  $evalerror = $@;

 view release on metacpan or  search on metacpan

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

 view release on metacpan or  search on metacpan

lib/Net/Async/SPORE/Loader.pm  view on Meta::CPAN

use Net::Async::SPORE::Definition;

use JSON::MaybeXS;
use File::Spec;

sub inject_method(&@);

=head1 METHODS

=cut

lib/Net/Async/SPORE/Loader.pm  view on Meta::CPAN

Will raise an exception if the method is already there.

=cut

sub inject_method(&@) {
	my ($code, $class, $method) = @_;
	no strict 'refs';
	die "Method overlap for $method" if $class->can($method);
	*{join '::', $class, $method} = $code;
}

 view release on metacpan or  search on metacpan

lib/Net/CDP.pm  view on Meta::CPAN

	$result =~ s/:0(:0)+:/::/;
	$result =~ s/^0:/:/;
	$result;
}

sub _rethrow(&) {
	my $sub = shift;
	if (wantarray) {
		my @result = eval { &$sub };
		if ($@) {
			$@ =~ s/ at \S+ line \d+\.\n\z//;