# -*-perl-*-
# $Id: 36_dbi_linked_list.t,v 1.4 2003/01/02 05:58:29 lachoy Exp $
use strict;
use constant NUM_TESTS => 22;
my $TEST_TABLE_NAME = 'linked_list';
my $SPOPS_CLASS = 'DBILinkedList';
my $TEST_TABLE_SQL = <
import( tests => NUM_TESTS );
require_ok( 'SPOPS::Initialize' );
my $driver_name = $config->{DBI_driver};
my $spops_dbi_driver = get_spops_driver( $config, $driver_name );
$db = get_db_handle( $config );
create_table( $db, $TEST_TABLE_SQL, $TEST_TABLE_NAME );
# Create the class using SPOPS::Initialize
my $spops_config = {
tester => {
class => $SPOPS_CLASS,
isa => [ $spops_dbi_driver, 'SPOPS::DBI' ],
rules_from => [ 'SPOPS::Tool::DBI::MaintainLinkedList' ],
field => [ qw( object_id prev_id next_id entered_on ) ],
skip_undef => [ qw( prev_id next_id ) ],
no_update => [ qw( object_id ) ],
id_field => 'object_id',
base_table => $TEST_TABLE_NAME,
table_name => $TEST_TABLE_NAME,
linklist_previous => 'prev_id',
linklist_next => 'next_id',
},
};
my $class_init_list = eval { SPOPS::Initialize->process({ config => $spops_config }) };
ok( ! $@, 'Initialize process run' );
is( $class_init_list->[0], $SPOPS_CLASS, 'Initialize class' );
#SPOPS->set_global_debug(2);
# First see that everything works for the default head locator
# ('null')
my ( $item1, $item2, $item3, $item4 );
eval {
$item1 = $SPOPS_CLASS->new({ id => 1, entered_on => (time - 50000) })->save();
$item2 = $SPOPS_CLASS->new({ id => 2, entered_on => (time - 40000) })->save();
$item3 = $SPOPS_CLASS->new({ id => 3, entered_on => (time - 30000) })->save();
$item4 = $SPOPS_CLASS->new({ id => 4, entered_on => (time - 20000) })->save();
};
# Check modifications in-place
is( $item2->{prev_id}, 1, "Initial second previous" );
is( $item3->{prev_id}, 2, "Initial third previous" );
is( $item4->{prev_id}, 3, "Initial fourth previous" );
# Check saved modifications
my ( $new1, $new2, $new3, $new4 );
eval {
$new1 = $SPOPS_CLASS->fetch(1);
$new2 = $SPOPS_CLASS->fetch(2);
$new3 = $SPOPS_CLASS->fetch(3);
$new4 = $SPOPS_CLASS->fetch(4);
};
is( $new1->{next_id}, 2, "Post first next" );
is( $new2->{prev_id}, 1, "Post second previous" );
is( $new2->{next_id}, 3, "Post second next" );
is( $new3->{prev_id}, 2, "Post third previous" );
is( $new3->{next_id}, 4, "Post third next" );
is( $new4->{prev_id}, 3, "Post fourth previous" );
is( $new4->{next_id}, undef, "Post fourth next" );
# Check modifications after a remove
eval { $new3->remove };
my $rmv2 = $SPOPS_CLASS->fetch(2);
my $rmv4 = $SPOPS_CLASS->fetch(4);
is( $rmv2->{next_id}, 4, "Post remove second next" );
is( $rmv4->{prev_id}, 2, "Post remove fourth previous" );
# See whether the autogen methods work
my $rmv2_next = $rmv2->next_in_list;
my $rmv4_prev = $rmv4->previous_in_list;
is( $rmv2_next->id, $rmv4->id, "Autogen next method" );
is( $rmv4_prev->id, $rmv2->id, "Autogen previous method" );
is( $rmv4->next_in_list, undef, "Autogen next method return undef" );
# Now change the head locator methods and see how an insert works
$SPOPS_CLASS->CONFIG->{linklist_head} = 'order';
$SPOPS_CLASS->CONFIG->{linklist_head_order} = 'entered_on DESC';
my $ordered5 = $SPOPS_CLASS->new({ id => 5, entered_on => (time - 10000) })->save();
my $ordered4 = $SPOPS_CLASS->fetch(4);
is( $ordered4->{next_id}, 5, "Ordered head insert next" );
is( $ordered5->{prev_id}, 4, "Ordered head insert previous" );
$SPOPS_CLASS->CONFIG->{linklist_head} = 'value';
$SPOPS_CLASS->CONFIG->{linklist_head_value} = -1;
$ordered5->{next_id} = -1;
eval { $ordered5->save };
my $value6 = $SPOPS_CLASS->new({ id => 6, entered_on => time })->save();
my $value5 = $SPOPS_CLASS->fetch(5);
is( $value5->{next_id}, 6, "Value head insert next" );
is( $value6->{prev_id}, 5, "Value head insert previous" );
}