#! /usr/bin/env perl

#
# Verify that $dbh->tables() returns a list of (quoted) tables.
#
# Changes 2011-01-21   stefansbv:
# - localized variables per test block
#

use strict;
use warnings;

use DBI 1.19; # FetchHashKeyName support (2001-07-20)
use Test::More; # tests => 19;

use constant TI_DBI_FIELDS =>
             [qw/ TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS / ];

# IB/FB derivatives can add at least 'ib_owner_name'
# (rdb$relations.rdb$owner_name) to the ordinary DBI table_info() fields.
use constant TI_IB_FIELDS =>
             [ @{TI_DBI_FIELDS()}, 'IB_OWNER_NAME' ];

# FIXME - consolidate that duplicated code

# Make -w happy
$::test_dsn = '';
$::test_user = '';
$::test_password = '';

for my $file ('t/testlib.pl', 'testlib.pl') {
    next unless -f $file;
    eval { require $file };
    BAIL_OUT("Cannot load testlib.pl\n") if $@;
    last;
}

sub contains {
    my ($superset, $subset) = @_;

    # for our purposes, sets must not be empty
    if (0 == @$superset or 0 == @$subset) {
        die "Empty set given to contains()";
    }

    my %super = map {$_=>undef} @$superset;
    for my $element (@$subset) {
        return undef unless exists $super{$element};
    }
    return 1;
}

# === BEGIN TESTS ===

my $dbh = DBI->connect($::test_dsn, $::test_user, $::test_password,
                       { RaiseError => 1, FetchHashKeyName => 'NAME_uc' });
ok($dbh);

# -- List all catalogs (none)
{
    my $sth = $dbh->table_info('%', '', '');
    my $r = $sth->fetch;
    ok(!defined($r), "No DBI catalog support");
    ok(contains($sth->{NAME_uc}, TI_DBI_FIELDS),
       "Result set contains expected table_info() fields");
}

# -- List all schema (none)
{
    my $sth = $dbh->table_info('', '%', '');
    ok(!defined($sth->fetch), "No DBI schema support");
    ok(contains($sth->{NAME_uc}, TI_DBI_FIELDS),
       "Result set contains expected table_info() fields");
}

# -- List all supported types
{
    my $sth = $dbh->table_info('', '', '', '%');
    my @types;
    while (my $r = $sth->fetchrow_hashref) {
        push @types, $r->{TABLE_TYPE};
    }
    ok(contains(\@types, ['VIEW', 'TABLE', 'SYSTEM TABLE']),
       "Minimal types supported");
}

# -- Literal table specification
{
    for my $tbl_spec ('RDB$DATABASE') {
        my $sth1 = $dbh->table_info('', '', $tbl_spec);
        my $r1 = $sth1->fetchrow_hashref;
        is($r1->{TABLE_NAME}, $tbl_spec, "TABLE_NAME is $tbl_spec");
        is($r1->{TABLE_TYPE}, 'SYSTEM TABLE', 'TABLE_TYPE is SYSTEM TABLE');
        ok(contains($sth1->{NAME_uc}, TI_IB_FIELDS),
           "Result set contains expected table_info() fields");
        ok(!defined($sth1->fetch), "One and only one row returned for $tbl_spec");

        my $sth2 = $dbh->table_info('', '', $tbl_spec, 'VIEW');
        ok(!defined($sth2->fetch), "No VIEW named $tbl_spec");
        ok(contains($sth2->{NAME_uc}, TI_IB_FIELDS),
           "Result set contains expected table_info() fields");

        my $sth3 = $dbh->table_info('', '', $tbl_spec, 'VIEW,SYSTEM TABLE');
        my $r3 = $sth3->fetchrow_hashref;
        is($r3->{TABLE_NAME}, $tbl_spec, "$tbl_spec found (multiple TYPEs given)");
        is($r3->{TABLE_TYPE}, 'SYSTEM TABLE', 'TABLE_TYPE is SYSTEM TABLE (multiple TYPEs given)');
        ok(!defined($sth3->fetch), "Only one row returned (multiple TYPEs given)");
        ok(contains($sth3->{NAME_uc}, TI_IB_FIELDS),
           "Result set contains expected table_info() fields");
    }
}

# -- Pattern tests
#    Similar to the literal table spec, but may return more than one
#    matching entry (remember: '_' and '%' are search pattern characters)

for my $tbl_spec ('RDB$D_T_B_S_', 'RDB$%', '%', '') {

    #
    {
        my $sth = $dbh->table_info('', '', $tbl_spec);
        ok(contains($sth->{NAME_uc}, TI_IB_FIELDS),
           "Result set contains expected table_info() fields");
        my ($table_name, $table_type);
        while (my $r = $sth->fetchrow_hashref) {
            if ( $r->{TABLE_NAME} eq 'RDB$DATABASE' ) {
                $table_name = $r->{TABLE_NAME};
                $table_type = $r->{TABLE_TYPE};
                last;
            }
        }
        is( $table_name, 'RDB$DATABASE',
            "RDB\$DATABASE found against '$tbl_spec'" );
        is( $table_type, 'SYSTEM TABLE', 'is SYSTEM TABLE' );
    }

    #
    {
        my $sth = $dbh->table_info('', '', $tbl_spec, 'VIEW,SYSTEM TABLE');
        ok(contains($sth->{NAME_uc}, TI_IB_FIELDS),
           "Result set contains expected table_info() fields");

        my ($table_name, $table_type);
        while (my $r = $sth->fetchrow_hashref) {
            if ( $r->{TABLE_NAME} eq 'RDB$DATABASE' ) {
                $table_name = $r->{TABLE_NAME};
                $table_type = $r->{TABLE_TYPE};
                last;
            }
        }

        is( $table_name, 'RDB$DATABASE',
            "RDB\$DATABASE found against '$tbl_spec' (multiple TYPEs)" );
        is( $table_type, 'SYSTEM TABLE', 'is SYSTEM TABLE (multiple TYPEs)' );
    }
}

done_testing;

__END__
# vim: set et ts=4:
