view release on metacpan or  search on metacpan

t/50dbm_simple.t  view on Meta::CPAN

    }
    else
    {
	# XXX from PP part of List::MoreUtils
	eval <<'EOP';
sub part(&@) {
    my ($code, @list) = @_;
    my @parts;
    push @{ $parts[$code->($_)] }, $_  for @list;
    return @parts;
}

 view release on metacpan or  search on metacpan

t/Util.pm  view on Meta::CPAN

                           },
                       ) or die $DBI::errstr;
    ($mysqld, $dbh);
}

sub capture(&) {
    my ($code) = @_;

    open my $fh, '>', \my $content;
    $fh->autoflush(1);
    local $DBIx::AssertIndex::OUTPUT = $fh;

 view release on metacpan or  search on metacpan

lib/DBIx/Brev.pm  view on Meta::CPAN

    $dbh = $_[0] if @_;
    $dbc = $dbh unless $use_connector;
    $dbh;
}

sub shift_params(&\@) {
    my ($predicate,$params) = @_;
    local $_ = shift(@$params);
    my $p = $_;
    if (eval {$predicate->($_) && 1}) {
        return $p;

lib/DBIx/Brev.pm  view on Meta::CPAN

    my @result;
    while (my $row  = $sth->fetchrow_hashref) { push @result,$row; }
    wantarray()?@result:\@result;
}

sub sql_map(&@)
{
    my $callback = shift;
    my $sth = get_sth(@_);
    my @result = ();
    my $wantresult = defined wantarray;

 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/DBIx/Class/Migration/RunScript.pm  view on Meta::CPAN

  @traits = grep { $INC{$_} ne $traits_path } @traits if $traits_path;
  #and return the last part of the path, the name of the plugin
  return map { m[$match]x } @traits;
}

sub builder(&) {
  my ($runs, @plugins) = reverse shift->();
  my (@traits, %args, %seen);
  foreach my $plugins (@plugins) {
    if(ref $plugins) {
      %args = (%args, %$plugins);

lib/DBIx/Class/Migration/RunScript.pm  view on Meta::CPAN

  return __PACKAGE__
    ->new_with_traits(traits=>\@traits, runs=>$runs, %args)
    ->as_coderef;
}

sub migrate(&) {
  my $runs = shift;
  builder {
    default_plugins(),
    used_plugins(),
    $runs,

 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/DBIx/Class/Schema/Loader/Utils.pm  view on Meta::CPAN

    $class_path .= '.pm';

    return $class_path;
}

sub no_warnings(&;$) {
    my ($code, $test_name) = @_;

    my $failed = 0;

    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };

lib/DBIx/Class/Schema/Loader/Utils.pm  view on Meta::CPAN

    $code->();

    Test::More::ok ((not $failed), $test_name);
}

sub warnings_exist(&$$) {
    my ($code, $re, $test_name) = @_;

    my $matched = 0;

    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };

lib/DBIx/Class/Schema/Loader/Utils.pm  view on Meta::CPAN

    $code->();

    Test::More::ok $matched, $test_name;
}

sub warnings_exist_silent(&$$) {
    my ($code, $re, $test_name) = @_;

    my $matched = 0;

    local $SIG{__WARN__} = sub { $matched = 1 if $_[0] =~ $re; };

 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

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

sub HR_connect {HR->dbh($dbh)};


# die_ok : succeeds if the supplied coderef dies with an exception
sub die_ok(&) {
  my $code=shift;
  eval {$code->()};
  my $err = $@;
  $err =~ s/ at .*//;
  ok($err, $err);

 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/t/Util.pm  view on Meta::CPAN

    }

    return $POSTGRESQLD;
}

sub capture(&) {
    my ($code) = @_;

    open my $fh, '>', \my $content;
    $fh->autoflush(1);
    local $DBIx::QueryLog::OUTPUT = $fh;
    $code->();
    close $fh;
    return $content;
}

sub capture_logger(&) {
    my ($code) = @_;

    my $content;

    my $logger = DBIx::QueryLog->logger;

 view release on metacpan or  search on metacpan

t/HashBase.t  view on Meta::CPAN

use warnings;

use Test::More;


sub warnings(&) {
    my $code = shift;
    my @warnings;
    local $SIG{__WARN__} = sub { push @warnings => @_ };
    $code->();
    return \@warnings;
}

sub exception(&) {
    my $code = shift;
    local ($@, $!, $SIG{__DIE__});
    my $ok = eval { $code->(); 1 };
    my $error = $@ || 'SQUASHED ERROR';
    return $ok ? undef : $error;

 view release on metacpan or  search on metacpan

lib/DBIx/QuickORM.pm  view on Meta::CPAN

    $col->{conflate} = $c if $col;

    return $c;
}

sub inflate(&) {
    my $self = shift;
    my ($code) = @_;

    croak "inflate() requires a coderef" unless $code and ref($code) eq 'CODE';

lib/DBIx/QuickORM.pm  view on Meta::CPAN

    }

    croak "inflate() can only be used inside either a conflator builder or a column builder"
}

sub deflate(&) {
    my $self = shift;
    my ($code) = @_;
    croak "deflate() requires a coderef" unless $code and ref($code) eq 'CODE';

    if (my $state = build_state) {

 view release on metacpan or  search on metacpan

t/10-basic-ok.t  view on Meta::CPAN

use Test::Most;

use DBIx::RetryConnect qw(NullP);

sub is_not_delayed(&) {
    my $start_time = time;
    shift->();
    cmp_ok time - $start_time, '<=', 5, 'executed reasonably quickly';
}

 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/DBIx/Schema/DSL.pm  view on Meta::CPAN

    }

    $c->_clear_creating_table;
    1;
}
sub columns(&) {shift}

sub _detect_undefined_columns {
    my ($set, $subset) = @_;

    my $diff = Array::Diff->diff([sort @$set], [sort @$subset]);

 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/Util.pm  view on Meta::CPAN

        }) or return;
    }
    return $mysqld;
}

sub capture(&) {
    my ($code) = @_;

    my @logs;
    my $tracer = DBIx::Tracer->new(sub {
        my %args = @_;

 view release on metacpan or  search on metacpan

lib/DBIx/TransactionManager/Distributed.pm  view on Meta::CPAN

L<DBI/begin_work> / L<DBI/commit> pair, there's no 2-phase commit or other
distributed transaction co-ordination happening here.

=cut

sub txn(&;@) {
    my ($code, @categories) = @_;
    die "Need a database category" unless @categories;
    _check_fork();
    my $wantarray = wantarray;
    for my $category (@categories) {

 view release on metacpan or  search on metacpan

examples/lib/Test/TinyMocker.pm  view on Meta::CPAN

@EXPORT = qw(mock unmock should method methods mocked);

sub mocked($$) { $mocks->{join("::", @_)} }
sub method($)  {@_}
sub methods($) {@_}
sub should(&)  {@_}

sub mock {
    croak 'useless use of mock with one or less parameter'
      if scalar @_ < 2;

 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/Data/CSel.pm  view on Meta::CPAN

    } else {
        return @res;
    }
}

sub csel_each(&;@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my $cb = shift;
    for my $node (csel(@_)) {
        local $_ = $node;
        $cb->($_);
    }