The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More tests => 14;
use DBI;
use PGObject;


is(PGObject->new_registry('test1'), 1, 'New registry 1 created');
is(PGObject->new_registry('blank'), 1, 'New registry blank created');
is(PGObject->new_registry('test2'), 1, 'New registry 2 created');
is(PGObject->register_type(pg_type => 'int4', perl_class => 'test1'), 1,
       "Basic type registration");
is(PGObject->register_type(
        pg_type => 'int4', perl_class => 'test2', registry => 'test1'), 1,
       "Basic type registration");

SKIP: {
    skip 'No database connection', 9 unless $ENV{DB_TESTING};

    # Initial db setup

    my $dbh1 = DBI->connect('dbi:Pg:', 'postgres') ;


    $dbh1->do('CREATE DATABASE pgobject_test_db') if $dbh1;




    my $dbh = DBI->connect('dbi:Pg:dbname=pgobject_test_db', 'postgres') if $dbh1;




    $dbh->{pg_server_prepare} = 0 if $dbh;


    # Functions to test.


    $dbh->do('
    CREATE OR REPLACE FUNCTION test_serialization(int) returns int language sql as $$
    SELECT $1;
    $$') if $dbh;

    $dbh->do('
    CREATE OR REPLACE FUNCTION test_int() returns int language sql as $$
    SELECT 1000;
    $$') if $dbh;

    $dbh->do('
    CREATE OR REPLACE FUNCTION test_ints() returns int[] language sql as $$
    SELECT array[1000::int, 100, 10];
    $$') if $dbh;
    my ($result) = PGObject->call_procedure(
        funcname   => 'test_int',
        args       => [],
        dbh        => $dbh,
    );

    is($result->{test_int}, 4, 'Correct handling of override, default registry');

    ($result) = PGObject->call_procedure(
        funcname   => 'test_int',
        args       => [],
        dbh        => $dbh,
        registry   => 'test1',
    );


    is($result->{test_int}, 8, 'Correct handling of override, named registry');

    ok(($result) = PGObject->call_procedure(
        funcname   => 'test_ints',
        args       => [],
        dbh        => $dbh,
    ));

    for (0 .. 2) {
        is $result->{test_ints}->[$_], 4, "Array element $_ handled by registered type";
    }

    ($result) = PGObject->call_procedure(
        funcname   => 'test_int',
        args       => [],
        dbh        => $dbh,
        registry   => 'test2',
    );

   
    is($result->{test_int}, 1000, 
          'Correct handling of override, named registry with no override');

    my $test = bless {}, 'test1';
    ok(($result) = PGObject->call_procedure(
        funcname => 'test_serialization',
             dbh => $dbh,
            args => [$test],
        registry => 'blank',
    ), 'called test_serialization correctly');
    is($result->{test_serialization}, 8, 'serialized to db correctly');
           
    $dbh->disconnect if $dbh;
    $dbh1->do('DROP DATABASE pgobject_test_db') if $dbh1;
    $dbh1->disconnect if $dbh1;
}


package test1;

sub from_db {
    return 4;
}

sub to_db {
    return 8
}

package test2;

sub from_db {
    return 8
}