Aniki

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

   - fixed packaging

1.04_01 2017-06-21T06:55:28Z

   - added update_and_(fetch|emulate)_row method (mamimumemoomoo)

1.04 2017-05-28T13:03:12Z

   - fixed range condition maker (thanks mamimumemoomoo)
   - namespace cleaner switched to namespace::autoclean (thanks karenetheridge)
   - throw more intelligibly error when calling update without data (thanks GeJ)
   - droped typoed (obsoluted) `make_range_condtion` method

1.03 2017-03-29T11:24:39Z

   - [EXPERIMENTAL] x_static_install=1 (no feature changes)

1.02 2017-02-10T06:14:56Z

   - added lt/gt alias option for lower/upper (watanabe-yoichi)

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

    my ($class, $databases, $code) = @_;
    for my $database (@$databases) {
        Test::Builder->new->subtest($database => sub {
            my $subclass = eval { $class->get_or_create_anon_class_by_database($database) };
            if (my $reason = $@) {
                if (t::DB::Exception->caught($reason)) {
                    Test::Builder->new->note($reason->message);
                    Test::Builder->new->plan(skip_all => "Cannot use $database");
                    return;
                }
                die $reason; # rethrow
            }
            $subclass->$code($database);
        });
    }
}

sub get_or_create_anon_class_by_database {
    my ($class, $database) = @_;
    state %class_cache;
    return $class_cache{$database} ||= $class->create_anon_class_by_database($database);

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

}

sub prepare_testing {
    my ($class, $schema_class) = @_;
    my $ddl = $schema_class->output;
    if ($schema_class->context->db eq 'MySQL') {
        eval {
            require DBD::mysql;
            require Test::mysqld;
        };
        t::DB::Exception->throw(message => $@) if $@;

        Test::Builder->new->note('launch mysqld ...');
        my $mysqld = Test::mysqld->new(
            my_cnf => {
                'skip-networking' => '', # no TCP socket
            }
        );
        t::DB::Exception->throw(message => $Test::mysqld::errstr) unless $mysqld;

        my $dbh = DBI->connect($mysqld->dsn(dbname => 'test'), 'root', '', {
            AutoCommit => 1,
            PrintError => 0,
            RaiseError => 1,
        });
        $dbh->do($_) for grep /\S/, split /;/, $ddl;

        $class->meta->add_around_method_modifier(BUILDARGS => sub {
            my $orig  = shift;

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

            my %args  = @_ == 1 ? %{+shift} : @_;
            $args{connect_info} = [$mysqld->dsn(dbname => 'test'), 'root', ''];
            return $class->$orig(\%args);
        });
    }
    elsif ($schema_class->context->db eq 'PostgreSQL') {
        eval {
            require DBD::Pg;
            require Test::postgresql;
        };
        t::DB::Exception->throw(message => $@) if $@;

        Test::Builder->new->note('launch postgresql ...');
        my $pgsql = Test::postgresql->new();
        t::DB::Exception->throw(message => $Test::postgresql::errstr) unless $pgsql;

        my $dbh = DBI->connect($pgsql->dsn, '', '', {
            AutoCommit => 1,
            PrintError => 0,
            RaiseError => 1,
        });
        $dbh->do($_) for grep /\S/, split /;/, $ddl;

        $class->meta->add_around_method_modifier(BUILDARGS => sub {
            my $orig  = shift;

t/lib/t/DB/Exception.pm  view on Meta::CPAN

use Scalar::Util qw/blessed/;

sub new {
    my $class = shift;
    return bless {@_} => $class;
}

sub message { shift->{message} }

sub throw { die shift->new(@_) }

sub caught {
    my ($class, $e) = @_;
    return blessed $e && $e->isa($class);
}

1;
__END__