# -*-perl-*-
# $Id: 30_dbi.t,v 3.5 2003/05/10 19:22:41 lachoy Exp $
# Note that this is a good way to see if certain databases support the
# type checking methods of the DBI -- in fact, we might want to add
# some date/datetime items in the table as well to see what happens
use strict;
use Data::Dumper qw( Dumper );
use constant NUM_TESTS => 62;
use constant TEST_TABLE_NAME => 'spops_test';
my $SPOPS_CLASS = 'DBITest';
my @ID_LIST = ( 42, 1792, 1588 );
my ( $db, $do_end );
END {
cleanup( $db, TEST_TABLE_NAME ) if ( $do_end );
}
# Table definition, just for reference
# CREATE TABLE foo (
# spops_id int not null primary key,
# spops_name char(20),
# spops_goop char(20) not null,
# spops_num int default 2
# )
{
# 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 );
# Ensure we can get to SPOPS::Initialize
require_ok( 'SPOPS::Initialize' );
my $driver_name = $config->{DBI_driver};
my $spops_dbi_driver = get_spops_driver( $config, $driver_name );
# Create the class using SPOPS::Initialize
my $spops_config = {
tester => {
class => $SPOPS_CLASS,
isa => [ $spops_dbi_driver, 'SPOPS::DBI' ],
field => [ qw/ spops_id spops_name spops_goop spops_num / ],
id_field => 'spops_id',
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 );
# Check that class was initialized ok
is( scalar @{ $SPOPS_CLASS->field_list },
scalar @{ $spops_config->{tester}{field} },
"Class initialize set 'field_list' property" );
is( $SPOPS_CLASS->table_name, TEST_TABLE_NAME,
"Class initialize set 'table_name' property" );
# Create a database handle and create our testing table
$db = get_db_handle( $config );
create_table( $db, 'simple', TEST_TABLE_NAME );
my $sql_data_types = get_sql_types( $db, TEST_TABLE_NAME, $driver_name );
# See whether we get back the right information for various
# configuration items
{
my $base_id_field = $SPOPS_CLASS->id_field;
my ( $id_field ) = $SPOPS_CLASS->id_field_select;
is( $id_field, TEST_TABLE_NAME . ".$base_id_field", "ID field for SELECT" );
my ( $nq_id_field ) = $SPOPS_CLASS->id_field_select({ noqualify => 1 });
is( $nq_id_field, $base_id_field, "ID field for SELECT (not qualified)" );
my $id_for_clause = 45;
my $data_type = $sql_data_types->{ $base_id_field };
my $quoted = $db->quote( $id_for_clause, $data_type );
my $id_clause = $SPOPS_CLASS->id_clause( $id_for_clause, undef,
{ db => $db } );
is( $id_clause, TEST_TABLE_NAME . ".$base_id_field = $quoted", "ID clause" );
my $nq_id_clause = $SPOPS_CLASS->id_clause( $id_for_clause, 'noqualify',
{ db => $db } );
#warn "Datatype: [$data_type]; Clauses: [$id_clause] [$nq_id_clause]\n";
is( $nq_id_clause, "$base_id_field = $quoted", "ID clause" );
}
# Create an object
{
my $obj = eval { $SPOPS_CLASS->new({ spops_name => 'MyProject',
spops_goop => 'oopie doop',
spops_num => 241,
spops_id => 42 } ) };
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";
}
}
# Try to fetch an object with an empty ID
{
my $obj = eval { $SPOPS_CLASS->fetch( '', { db => $db, skip_cache => 1 }) };
ok( ! $@, 'Fetch object (empty ID)' );
is( $obj, undef, 'Fetched object with empty ID is undef' );
my $obj_u = eval { $SPOPS_CLASS->fetch( undef, { db => $db, skip_cache => 1 }) };
ok( ! $@, 'Fetch object (undef ID)' );
is( $obj, undef, 'Fetched object with undef ID is undef' );
}
# Fetch an object, then update it
{
my $obj = eval { $SPOPS_CLASS->fetch( 42, { db => $db, skip_cache => 1 } ) };
ok( ! $@, 'Fetch object (perform)' );
if ( $@ ) {
warn "Cannot fetch object: $@\n", Dumper( SPOPS::Error->get ), "\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( 42, { 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
{
my $obj = eval { $SPOPS_CLASS->fetch( 42, { db => $db, skip_cache => 1 } ) };
my $new_obj = eval { $obj->clone({ spops_name => 'YourProject',
spops_goop => 'this n that',
spops_id => 1792 } ) };
ok( ! $@, 'Clone object (perform)' );
ok( $new_obj->{spops_name} ne $obj->{spops_name}, 'Clone object (correct data)');
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. Also pass along an
# 'insert_alter' statement and see if it worked.
{
my $obj = $SPOPS_CLASS->new({ spops_id => 1588,
spops_goop => 'here we go!',
spops_name => 'AnotherProject' });
eval { $obj->save({ is_add => 1, db => $db, skip_cache => 1,
insert_alter => { spops_goop => "'added -- %s'" } }) };
ok( ! $@, 'Insert object with default data unspecified' );
is( $obj->{spops_num}, 2, 'Fetch object (correct data with default)' );
my $redo_obj = eval { $SPOPS_CLASS->fetch( $obj->id,
{ db => $db, skip_cache => 1 } ) };
is( $redo_obj->{spops_goop}, "added -- here we go!", 'Insert alter' );
}
# Fetch one of the above objects, update by hand one of the values
# in the table and then refetch that field to see if it works
{
my $obj = eval { $SPOPS_CLASS->fetch( 42, { db => $db,
skip_cache => 1 } ) };
my $orig = $obj->{spops_name};
my $new_set = "Changed for refetch";
my $sql = 'UPDATE ' . TEST_TABLE_NAME .
' SET spops_name = ? ' .
' WHERE ' . $obj->id_clause( undef, undef, { db => $db }) ;
my ( $sth );
eval {
$sth = $db->prepare( $sql );
$sth->execute( $new_set );
};
ok( ! $@, 'Update for refetch' );
my $new_return = $obj->refetch( 'spops_name', { db => $db } );
is( $obj->{spops_name}, $new_set, 'Refetched field match' );
is( $new_return, $new_set, 'Refetched and returned field match' );
}
# Fetch one of the above objects, then update only one field
{
my $obj = eval { $SPOPS_CLASS->fetch( 42, { db => $db,
skip_cache => 1 } ) };
my $changed = 'One field update';
$obj->{spops_name} = $changed;
my $rv = eval { $obj->field_update( 'spops_name', { db => $db } ) };
diag( "[RV $rv] $@" ) if ( $@ );
ok( $rv && ! $@, 'Field update (single) execution' );
is( $obj->{spops_name}, $changed, 'Field update (single) internal match' );
my $redo_obj = eval { $SPOPS_CLASS->fetch( 42, { db => $db,
skip_cache => 1 } ) };
is( $redo_obj->{spops_name}, $obj->{spops_name}, 'Field update (single) external match' );
}
# Now try to do a field update with multiple fields
{
my $obj = eval { $SPOPS_CLASS->fetch( 42, { db => $db,
skip_cache => 1 } ) };
my $changed_text = 'Multi field update';
my $changed_num = 1066;
my $rv = eval { $obj->field_update({ spops_name => $changed_text,
spops_num => $changed_num },
{ db => $db } ) };
warn $@ if ( $@ );
ok( $rv && ! $@, 'Field update (multiple) execution' );
is( $obj->{spops_name}, $changed_text, 'Field update (multiple) internal match' );
is( $obj->{spops_num}, $changed_num, 'Field update (multiple) internal match' );
my $redo_obj = eval { $SPOPS_CLASS->fetch( 42, { db => $db,
skip_cache => 1 } ) };
is( $redo_obj->{spops_name}, $obj->{spops_name}, 'Field update (multiple) external match' );
is( $redo_obj->{spops_num}, $obj->{spops_num}, 'Field update (multiple) external match' );
}
# Now do a field update with multiple objects (class-level call)
{
my $changed_text = 'Multi field update';
my $rv = eval { $SPOPS_CLASS->field_update( { spops_name => $changed_text },
{ db => $db,
where => 'spops_num > 0' } ) };
warn $@ if ( $@ );
ok( $rv, 'Field update (multiple object) execution' );
my $obj_list = eval { $SPOPS_CLASS->fetch_group({ db => $db, skip_cache => 1 }) };
warn $@ if ( $@ );
is( $obj_list->[0]->{spops_name}, $changed_text, 'Field update (multiple object 1) match' );
is( $obj_list->[1]->{spops_name}, $changed_text, 'Field update (multiple object 2) match' );
is( $obj_list->[2]->{spops_name}, $changed_text, 'Field update (multiple object 3) match' );
}
# Try a class-level field update where we match a single object
{
my $changed = 'Class level update';
my $rv = eval { $SPOPS_CLASS->field_update( { spops_name => $changed },
{ where => 'spops_num = 1066',
db => $db } ) };
warn $@ if ( $@ );
ok( $rv, 'Field update (multiple object) execution with one match' );
my $obj_list = eval { $SPOPS_CLASS->fetch_group({ where => 'spops_num = ?',
value => [ 1066 ],
db => $db,
skip_cache => 1 }) };
is( $obj_list->[0]{spops_name}, $changed, 'Field update (single object) match' );
}
# Try a field update with multiple objects (class-level call)
# where nothing matches
{
my $changed_text = 'Multi field update';
my $rv = eval { $SPOPS_CLASS->field_update( { spops_name => $changed_text },
{ db => $db,
where => 'spops_num < 0' } ) };
warn $@ if ( $@ );
is( int( $rv ), 0, 'Field update (multiple object) execution with no match' );
}
# Fetch the three objects in the db and be sure we got them all
{
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
{
my $obj_count = eval { $SPOPS_CLASS->fetch_count({ db => $db }) };
ok( ! $@, 'Fetch count execution' );
is( $obj_count, 3, 'Fetch count value' );
my $skip_obj_count = eval {
$SPOPS_CLASS->fetch_count({ db => $db,
skip_security => 1 })
};
ok( ! $@, 'Fetch count execution (security skipped)' );
is( $skip_obj_count, 3, 'Fetch count value (security_skipped)' );
}
# Create an iterator and run through the objects
{
my $iter = eval { $SPOPS_CLASS->fetch_iterator({ db => $db,
skip_cache => 1 }) };
ok( ! $@, 'Fetch iterator execution' );
ok( $iter->isa( 'SPOPS::Iterator::DBI' ), 'Iterator returned (fetch_iterator)' );
my $count = 0;
$count++ while ( my $obj = $iter->get_next );
is( $count, 3, 'Iterator fetch count (fetch_iterator)' );
}
# Create an iterator from the object IDs then run through them
{
my $iter = SPOPS::Iterator::DBI->new({ id_list => \@ID_LIST,
class => $SPOPS_CLASS,
db => $db });
ok( $iter->isa( 'SPOPS::Iterator::DBI' ), 'Iterator returned (ID list)' );
my $count = 0;
$count++ while ( my $obj = $iter->get_next );
is( $count, 3, 'Iterator fetch count (ID list)' );
}
# Define an object but pass in a per-object 'no_insert' definition
{
my $obj = $SPOPS_CLASS->new({ spops_id => 4001, spops_name => 'FOO!',
spops_goop => 'OOF!', spops_num => 4001 });
eval { $obj->save({ is_add => 1,
no_insert => [ 'spops_name' ],
db => $db, skip_cache => 1 }) };
ok( ! $@, 'Insert object with "no_insert" field specified' );
isnt( $obj->{spops_name}, 'FOO!', 'Data reset for no_insert field in object' );
my $new_obj = eval { $SPOPS_CLASS->fetch( 4001, { db => $db,
skip_cache => 1 }) };
ok( ! $@, 'Refetch no_insert object' );
isnt( $new_obj->{spops_name}, 'FOO!', 'Fetched data proper data for no_insert field' );
}
# Fetch an object for updating, change a field and ensure it
# didn't change
{
my $obj = eval { $SPOPS_CLASS->fetch( 4001,
{ db => $db, skip_cache => 1 }) };
ok( ! $@, "Fetch object for no_update" );
my $old_value = $obj->{spops_num};
$obj->{spops_num} = 5555;
eval { $obj->save({ no_update => [ 'spops_num' ],
db => $db, skip_cache => 1 }) };
ok( ! $@, 'Update object with "no_update" field specified' );
my $new_obj = eval { $SPOPS_CLASS->fetch( 4001,
{ db => $db, skip_cache => 1 }) };
ok( ! $@, 'Refetch no_update object' );
is( $new_obj->{spops_num}, $old_value, 'Old value not overwritten for no_update field' );
}
# Future testing ideas:
# - security
# - timestamp checking
# - fetch_group using 'where'
}