# -*-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)' ); }