# -*-perl-*- # $Id: 31_dbi_multifield.t,v 3.0 2002/08/28 01:16:32 lachoy Exp $ # Almost exactly the same as 30_dbi.t, but here we're testing whether # multiple-field primary keys work ok use strict; use Data::Dumper qw( Dumper ); use constant NUM_TESTS => 22; use constant TEST_TABLE_NAME => 'spops_multi_test'; my $SPOPS_CLASS = 'DBIMultiTest'; my ( $db, $do_end ); END { if ( $do_end ) { cleanup( $db, TEST_TABLE_NAME ); } } { # Grab our DBI routines and be sure we're supposed to run. do "t/dbi_config.pl"; my $config = test_dbi_run(); $do_end++; require Test::More; Test::More->import( tests => NUM_TESTS ); my $driver_name = $config->{DBI_driver}; my $spops_dbi_driver = get_spops_driver( $config, $driver_name ); # Ensure we can get to SPOPS::Initialize # TEST: 1 require_ok( 'SPOPS::Initialize' ); # Create the class using SPOPS::Initialize # TEST: 2-3 my $spops_config = { tester => { class => $SPOPS_CLASS, isa => [ $spops_dbi_driver, 'SPOPS::DBI' ], field => [ qw/ spops_time spops_user spops_name spops_goop spops_num / ], id_field => [ 'spops_time', 'spops_user' ], skip_undef => [ 'spops_num' ], sql_defaults => [ 'spops_num' ], base_table => TEST_TABLE_NAME, table_name => TEST_TABLE_NAME, }, }; my $class_init_list = eval { SPOPS::Initialize->process({ config => $spops_config }) }; ok( ! $@, 'Initialize process run' ); is( $class_init_list->[0], $SPOPS_CLASS, 'Initialize class' ); check_dbd_compliance( $config, $driver_name, $SPOPS_CLASS ); # Create a database handle and create our testing table $db = get_db_handle( $config ); create_table( $db, 'multi', TEST_TABLE_NAME ); # See whether we get back the right information for various # configuration items # TEST 4-7 { my ( $base_id_field1, $base_id_field2 ) = $SPOPS_CLASS->id_field; my ( $id_field1, $id_field2 ) = $SPOPS_CLASS->id_field_select; is( $id_field1, TEST_TABLE_NAME . ".$base_id_field1", "ID field (1) for SELECT" ); is( $id_field2, TEST_TABLE_NAME . ".$base_id_field2", "ID field (2) for SELECT" ); my ( $nq_id_field1, $nq_id_field2 ) = $SPOPS_CLASS->id_field_select({ noqualify => 1 }); is( $nq_id_field1, $base_id_field1, "ID field for SELECT (not qualified)" ); is( $nq_id_field2, $base_id_field2, "ID field for SELECT (not qualified)" ); } my $obj_time = 1004897158; my $obj_user = 5; # Create an object # TEST: 7-8 { my $obj = eval { $SPOPS_CLASS->new({ spops_name => 'MyProject', spops_goop => 'oopie doop', spops_num => 241, spops_time => $obj_time, spops_user => $obj_user } ) }; ok( ! $@, 'Create object' ); # Save the object eval { $obj->save({ is_add => 1, db => $db, skip_cache => 1 }) }; ok( ! $@, 'Save object (create)' ); if ( $@ ) { warn "Error saving object: $@\n", Dumper( SPOPS::Error->get ), "\n"; } } # Fetch an object, then update it # TEST: 9-12 { my $obj = eval { $SPOPS_CLASS->fetch( "$obj_time,$obj_user", { db => $db, skip_cache => 1 } ) }; ok( ! $@, 'Fetch object (perform)' ); if ( $@ ) { warn "Cannot fetch object: $@\n"; } ok( $obj->{spops_name} eq 'MyProject', 'Fetch object (correct data)' ); $obj->{spops_name} = 'TheirProject'; $obj->{spops_goop} = 'over there'; eval { $obj->save({ db => $db, skip_cache => 1 }) }; ok( ! $@, 'Save object (update)' ); if ( $@ ) { warn "Cannot update object: $@\n", Dumper( SPOPS::Error->get ), "\n"; } my $new_obj = eval { $SPOPS_CLASS->fetch( "$obj_time,$obj_user", { db => $db, skip_cache => 1 } ) }; ok( $new_obj->{spops_name} eq $obj->{spops_name}, 'Fetch object (after update)' ); } # Fetch an object then clone it and save it # TEST: 13-16 { my $obj = eval { $SPOPS_CLASS->fetch( "$obj_time,$obj_user", { db => $db, skip_cache => 1 } ) }; my $new_obj = eval { $obj->clone({ spops_name => 'YourProject', spops_goop => 'this n that', spops_time => 1004897257 } ) }; ok( ! $@, 'Clone object (perform)' ); ok( $new_obj->{spops_name} ne $obj->{spops_name}, 'Clone object (correct data)'); $new_obj->{spops_user} = 12; eval { $new_obj->save( { is_add => 1, db => $db, skip_cache => 1 } ) }; ok( ! $@, 'Save object (create, after clone)' ); if ( $@ ) { warn "Cannot save object: $@\n", Dumper( SPOPS::Error->get ), "\n"; } } # Create another object, but this time don't define the spops_num # field and see if the default comes through # TEST: 17 { my $obj = $SPOPS_CLASS->new({ spops_time => 1004897292, spops_user => 5, spops_goop => 'here we go!', spops_name => 'AnotherProject' }); eval { $obj->save({ is_add => 1, db => $db, skip_cache => 1 }) }; ok( $obj->{spops_num} == 2, 'Fetch object (correct data with default' ); } # Fetch the three objects in the db and be sure we got them all # TEST: 18-19 { my $obj_list = eval { $SPOPS_CLASS->fetch_group({ db => $db, skip_cache => 1 } ) }; ok( ! $@, 'Fetch group' ); if ( $@ ) { warn "Cannot retrieve objects: $@\n", Dumper( SPOPS::Error->get ), "\n"; } ok( ref $obj_list eq 'ARRAY' && scalar @{ $obj_list } == 3, 'Fetch group (return check)' ); } # Fetch a count of the objects in the database # TEST: 20 { my $obj_count = eval { $SPOPS_CLASS->fetch_count({ db => $db }) }; ok( $obj_count == 3, 'Fetch count' ); } # Create an iterator and run through the objects # TEST: 21-22 { my $iter = eval { $SPOPS_CLASS->fetch_iterator({ db => $db, skip_cache => 1 }) }; ok( $iter->isa( 'SPOPS::Iterator' ), 'Iterator returned' ); my $count = 0; while ( my $obj = $iter->get_next ) { $count++; } ok( $count == 3, 'Iterator fetch count' ); } # Future testing ideas: # - security # - timestamp checking # - fetch_group using 'where' }