view release on metacpan or  search on metacpan

t/AnyEvent-Pg.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use 5.010;

# use Devel::FindRef;

$| = 1;
use Pg::PQ qw(:pgres);
use AnyEvent::Pg;
use AnyEvent::Pg::Pool;
use Test::More;

my ($ci, $tpg, $port);

if (defined $ENV{TEST_ANYEVENT_PG_CONNINFO}) {
    $ci = $ENV{TEST_ANYEVENT_PG_CONNINFO};
}
else {
    unless (eval { require Test::PostgreSQL; 1 }) {
        plan skip_all => "Unable to load Test::PostgreSQL: $@";
    }

    $tpg = eval { Test::PostgreSQL->new };
    unless ($tpg) {
        no warnings;
        plan skip_all => "Test::PostgreSQL failed to provide a database instance: $@";
    }


    $port = $tpg->port;
    $ci = { dbname => 'test',
            host   => '127.0.0.1',
            port   => $port,
            user   => 'postgres' };

    # use Data::Dumper;
    # diag(Data::Dumper->Dump( [$tpg, $ci], [qw(tpg *ci)]));
}

$port ||= 1234;

my @w;
my $queued = 0;

sub ok_query {
    my ($pg, @query) = @_;
    $queued++;
    my $ok;
    push @w, $pg->push_query(query => \@query,
                             on_error => sub {
                                 fail("query '@query' error: " . $_[1]->error);
                                 $queued--;
                             },
                             on_done  => sub {
                                 ok(defined $_[0]->last_query_start_time);
                                 # diag "last query start time: ", $_[0]->last_query_start_time, ", now: ", AE::now;

                                 ok($ok, "query '@query'");
                                 $queued--;
                             },
                             on_result => sub {
                                 my $status = $_[1]->status;
                                 $ok = 1 if $status == PGRES_TUPLES_OK or $status == PGRES_COMMAND_OK;
                             } );
}

sub fail_query {
    my ($pg, @query) = @_;
    $queued++;
    my $ok;
    push @w, $pg->push_query(query => \@query,
                             on_error => sub {
                                 fail("query '@query' error: " . $_[1]->error);
                                 $queued--;
                             },
                             on_done  => sub {
                                 ok(!$ok, "query '@query' should fail");
                                 $queued--;
                             },
                             on_result => sub {
                                 my $status = $_[1]->status;
                                 $ok = 1 if $status == PGRES_TUPLES_OK or $status == PGRES_COMMAND_OK;
                             } );
}


sub ok_query_prepare {
    my ($pg, $name, $query) = @_;
    $queued++;
    my $ok;
    push @w, $pg->push_prepare(name => $name, query => $query,
                               on_error => sub {
                                   fail("prepare query $name => '$query' error: " . $_[1]->error);
                                   $queued--;
                               },
                               on_done  => sub {
                                   ok($ok, "prepare query $name => '$query' passed");