The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*-perl-*-

# $Id: 35_dbi_type_info.t,v 1.3 2003/01/03 05:12:50 lachoy Exp $

use strict;
use constant NUM_TESTS       => 35;
use constant TEST_TABLE_NAME => 'spops_test';

my ( $db, $do_end );

END {
    cleanup( $db, TEST_TABLE_NAME ) if ( $do_end );
 }

{
    # Grab our DBI routines and be sure we're supposed to run.

    do "t/dbi_config.pl";
    my $config = test_dbi_run();

    require Test::More;

    if ( $config->{DBI_driver} eq 'SQLite' ) {
        Test::More->import( skip_all => "Cannot test DBI types with DBD::SQLite" );
    }
    Test::More->import( tests => NUM_TESTS );

    require DBI;
    DBI->import( qw( SQL_VARCHAR SQL_INTEGER SQL_TIMESTAMP ) );

    $db = get_db_handle( $config );
    create_table( $db, 'simple', TEST_TABLE_NAME );
    $do_end++;

    require_ok( 'SPOPS::DBI::TypeInfo' );

    my $ti_simple = eval { SPOPS::DBI::TypeInfo->new({ database => 'foo',
                                                       table    => 'bar' }) };
    ok( ! $@, 'Object created' );
    is( ref $ti_simple, 'SPOPS::DBI::TypeInfo', 'Type of object created' );
    is( $ti_simple->database, 'foo', 'Database set in constructor' );
    is( $ti_simple->table, 'bar', 'Table set in constructor' );

    my @simple_fields = ( 'one', 'two', 'three' );
    my @simple_types  = ( DBI::SQL_VARCHAR(), DBI::SQL_INTEGER(), DBI::SQL_TIMESTAMP() );
    my $ti_defined = eval { SPOPS::DBI::TypeInfo->new({
                              database => 'foo',
                              table    => 'bar',
                              fields   => \@simple_fields,
                              types    => \@simple_types }) };
    ok( ! $@, 'Object with fields and types created' );
    is_deeply( [ $ti_defined->get_fields ], \@simple_fields, 'Fields set' );
    is_deeply( [ $ti_defined->get_types ], \@simple_types, 'Types set' );
    is( $ti_defined->get_type( 'one' ), DBI::SQL_VARCHAR(), 'Field one set' );
    is( $ti_defined->get_type( 'two' ), DBI::SQL_INTEGER(), 'Field two set' );
    is( $ti_defined->get_type( 'three' ), DBI::SQL_TIMESTAMP(), 'Field three set' );


    my %simple_map = ( one   => 'char',
                         two   => 'int',
                         three => 'date' );
    my $ti_mapped = eval { SPOPS::DBI::TypeInfo->new({
                              database => 'foo',
                              table    => 'bar',
                              map      => \%simple_map }) };
    ok( ! $@, 'Object with mapped fields and types created' );
    is( scalar $ti_mapped->get_fields, 3, 'Fields mapped set' );
    is( scalar $ti_mapped->get_types, 3, 'Types mapped set' );
    is( $ti_mapped->get_type( 'one' ), DBI::SQL_VARCHAR(), 'Field mapped with fake type one set' );
    is( $ti_mapped->get_type( 'two' ), DBI::SQL_INTEGER(), 'Field mapped with fake type two set' );
    is( $ti_mapped->get_type( 'three' ), DBI::SQL_DATE(), 'Field mapped with fake type three set' );

    my $ti_shortcut =
         eval { SPOPS::DBI::TypeInfo->new({
                         database => 'foo',
                         table    => TEST_TABLE_NAME })->fetch_types( $db ) };
    diag( $@ ) if ( $@ );
    ok( ! $@, 'Object created with shortcut from fetching types' );
    is( scalar $ti_shortcut->get_fields, 4, 'Fields shortcut set' );
    is( scalar $ti_shortcut->get_types, 4, 'Types shortcut set' );
    is( $ti_shortcut->get_type( 'spops_id' ), DBI::SQL_INTEGER(), 'Field shortcut one set' );
    ok( $ti_shortcut->get_type( 'spops_name' ) == DBI::SQL_VARCHAR() ||
        $ti_shortcut->get_type( 'spops_name' ) == DBI::SQL_CHAR(), 'Field shortcut two set' );
    ok( $ti_shortcut->get_type( 'spops_goop' ) == DBI::SQL_VARCHAR() ||
        $ti_shortcut->get_type( 'spops_goop' ) == DBI::SQL_CHAR(), 'Field shortcut three set' );
    is( $ti_shortcut->get_type( 'spops_num' ), DBI::SQL_INTEGER(), 'Field shortcut four set' );

    # Ensure the fields/types as hash is returned ok

    my %map = $ti_shortcut->as_hash;
    is( scalar keys %map, 4, 'Number of fields in hash' );
    is( $map{spops_id}, DBI::SQL_INTEGER(), 'Field/type from hash one' );
    ok( $map{spops_name} == DBI::SQL_VARCHAR() ||
        $map{spops_name} == DBI::SQL_CHAR(), 'Field/type from hash two' );
    ok( $map{spops_goop} == DBI::SQL_VARCHAR() ||
        $map{spops_name} == DBI::SQL_CHAR(), 'Field/type from hash three' );
    is( $map{spops_num}, DBI::SQL_INTEGER(), 'Field/type from hash four' );

    my $added = eval { $ti_shortcut->add_type( 'spops_new', DBI::SQL_DATETIME() ) };
    ok( ! $@, 'New type added' );
    is( $added, DBI::SQL_DATETIME(), 'Return from get_type()' );
    my ( $added_new );
    {
        local $SIG{__WARN__} = sub {}; # get rid of warning from next line
        $added_new = eval { $ti_shortcut->add_type( 'SPOPS_NEW', DBI::SQL_INTEGER() ) };
    }
    ok( ! $@, 'New type to existing added (no error)' );
    is( $added_new, DBI::SQL_DATETIME(), 'Return from get_type() as previous value' );

    # Now some stuff that should fail

    my $ti_fail = eval { SPOPS::DBI::TypeInfo->new({ fields => [ 'a', 'b' ],
                                                      types => [ 'num' ] } ) };
    ok( $@, 'Constructor failed on uneven field/type assignment (good)' );

    $ti_fail = eval { SPOPS::DBI::TypeInfo->new()->fetch_types( $db ) };
    ok( $@, 'Retrieving types from DB failed without table set (good)' );
}