package tests::DerivedSchemaTest;
use strict;
use base qw/ Lire::Test::TestCase /;
use Lire::DlfSchema;
use Lire::ExtendedSchema;
use Lire::DerivedSchema;
use Lire::Field;
use Lire::DlfStore;
use Lire::Utils qw/tempdir/;
use File::Basename qw/dirname/;
use Cwd qw/realpath/;
sub new {
my $self = shift()->SUPER::new( @_ );
$self->{'tmpdir'} = tempdir( __PACKAGE__ . "XXXXXX",
'TMPDIR' => 1, CLEANUP => 1 );
return $self;
}
sub set_up {
my $self = $_[0];
$self->SUPER::set_up();
$self->{'directory'} = realpath( dirname(__FILE__) . "/schemas" );
$self->{'old_cache'} = { %Lire::DlfSchema::SCHEMA_CACHE };
%Lire::DlfSchema::SCHEMA_CACHE = ();
# Make sure the Lire::DlfSchema can find our test schemas.
$self->{'cfg'}{'lr_schemas_path'} = [ $self->{'directory'} ];
$self->{'schema'} = Lire::DlfSchema::load_schema( "test-derived" );
$self->{'cfg'}{'_lr_config_spec'} = $self->lire_default_config_spec();
# We don't open the store in new() because we need to
# change the configuration before
$self->{'store'} = Lire::DlfStore->open( "$self->{'tmpdir'}/store", 1 )
unless defined $self->{'store'};
return;
}
sub tear_down {
my $self = $_[0];
$self->SUPER::tear_down();
$self->{'store'}->_dbh()->rollback();
%Lire::DlfSchema::SCHEMA_CACHE = %{$self->{'old_cache'}};
return;
}
sub test_new {
my $self = $_[0];
$self->assert_dies( qr/cannot find superservice in id: 'test_derived'/,
sub { new Lire::DerivedSchema( 'id' => 'test_derived' ) } );
$self->assert_dies( qr/base schema cannot be an extended schema: test-extended/,
sub { new Lire::DerivedSchema( 'id' => 'test-another',
'base-schema' => 'test-extended' ) } );
my $schema = new Lire::DerivedSchema( 'id' => 'test-derived',
'module' => 'MyModule',
'base-schema' => 'test',
'timestamp' => 'session_start' );
$self->assert_isa( 'Lire::DerivedSchema', $schema );
$self->assert_str_equals( 'test-derived', $schema->{'id'} );
$self->assert_str_equals( 'test', $schema->{'superservice'} );
my $base = Lire::DlfSchema::load_schema( 'test' );
$self->assert_str_equals( $base, $schema->{'base'} );
}
sub test_id {
my $self = $_[0];
$self->assert_isa( 'Lire::DerivedSchema', $self->{'schema'} );
$self->assert_str_equals( "test-derived", $self->{'schema'}->id() );
}
sub test_superservice {
my $self = $_[0];
$self->assert_isa( 'Lire::DerivedSchema', $self->{'schema'} );
$self->assert_str_equals( "test", $self->{'schema'}->superservice() );
}
sub test_base {
my $self = $_[0];
$self->assert_isa( 'Lire::DerivedSchema', $self->{'schema'} );
my $base = $self->{'schema'}->base();
$self->assert_isa( 'Lire::DlfSchema', $base );
$self->assert_str_equals( "test", $base->id() );
}
sub test_can_join_schema {
my $self = $_[0];
my $test = new Lire::DlfSchema( 'superservice' => 'test',
'timestamp' => 'time' );
$test->add_field( new Lire::Field( 'name' => 'time',
'type' => 'timestamp' ) );
$Lire::DlfSchema::SCHEMA_CACHE{'test'} = $test;
my $test2 = new Lire::DlfSchema( 'superservice' => 'test2',
'timestamp' => 'time' );
$test2->add_field( new Lire::Field( 'name' => 'time',
'type' => 'timestamp' ) );
$Lire::DlfSchema::SCHEMA_CACHE{'test2'} = $test2;
my $derived = new Lire::DerivedSchema( 'id' => 'test-derived',
'base-schema' => 'test',
'timestamp' => 'time',
'module' => 'MyModule' );
$derived->add_field( new Lire::Field( 'name' => 'time',
'type' => 'timestamp' ) );
$Lire::DlfSchema::SCHEMA_CACHE{'test-derived'} = $derived;
my $ext1 = new Lire::ExtendedSchema( 'id' => 'test-ext1',
'base-schema' => 'test',
'module' => 'MyModule' );
my $ext2 = new Lire::ExtendedSchema( 'id' => 'test2-ext2',
'base-schema' => 'test2',
'module' => 'MyModule' );
my $ext3 = new Lire::ExtendedSchema( 'id' => 'test-ext3',
'base-schema' => 'test-derived',
'module' => 'MyModule' );
$self->assert( $derived->can_join_schema( $ext1 ) );
$self->assert( $derived->can_join_schema( $test ) );
$self->assert( $derived->can_join_schema( $ext3 ) );
$self->assert( ! $derived->can_join_schema( $derived ) );
$self->assert( ! $derived->can_join_schema( $ext2 ) );
$self->assert( ! $derived->can_join_schema( $test2 ) );
}
sub test_create_sql_schema {
my $self = $_[0];
$self->assert_isa( 'Lire::DerivedSchema', $self->{'schema'} );
$self->{'schema'}->create_sql_schema( $self->{'store'} );
my $sql_def = $self->{'schema'}->_sql_fields_def();
chomp $sql_def; # Trailing newline removed by SQLite
my $table = $self->{'store'}->_dbh()->selectrow_hashref( "SELECT * FROM sqlite_master WHERE name = 'dlf_test-derived'" );
$self->assert_not_null( $table, "table dlf_test wasn't created" );
$self->assert_matches( qr/\Q$sql_def\E/, $table->{'sql'} );
$self->check_derived_idx();
$self->check_link_table();
$self->check_triggers();
}
sub check_derived_idx {
my $self = $_[0];
my $index = $self->{'store'}->_dbh()->selectrow_hashref( q{SELECT * FROM sqlite_master WHERE name = 'dlf_test-derived_session_start_idx'} );
$self->assert_not_null( $index, "index dlf_test-derived_session_start_idx wasn't created" );
$self->assert_equals( "index", $index->{'type'} );
$self->assert_equals( 'CREATE INDEX "dlf_test-derived_session_start_idx" ON "dlf_test-derived" ( session_start )', $index->{'sql'} );
}
sub check_link_table {
my $self = $_[0];
my $dbh = $self->{'store'}->_dbh();
my $table = $dbh->selectrow_hashref( "SELECT * FROM sqlite_master WHERE name = 'dlf_test-derived_links'" );
$self->assert_not_null( $table, "table dlf_test-derived_links wasn't created" );
$self->assert_str_equals( 'CREATE TABLE "dlf_test-derived_links" ( src_id INT, link_id INT )',
$table->{'sql'} );
my $index = $dbh->selectrow_hashref( q{SELECT * FROM sqlite_master WHERE name = 'dlf_test-derived_links_src_id_idx'} );
$self->assert_not_null( $index, "index dlf_test-derived_links_src_id_idx wasn't created" );
$self->assert_str_equals( "index", $index->{'type'} );
$self->assert_str_equals( 'CREATE INDEX "dlf_test-derived_links_src_id_idx" ON "dlf_test-derived_links" ( src_id )', $index->{'sql'} );
$index = $dbh->selectrow_hashref( q{SELECT * FROM sqlite_master WHERE name = 'dlf_test-derived_links_link_id_idx'} );
$self->assert_not_null( $index, "index dlf_test-derived_links_link_id_idx wasn't created" );
$self->assert_str_equals( "index", $index->{'type'} );
$self->assert_str_equals( 'CREATE INDEX "dlf_test-derived_links_link_id_idx" ON "dlf_test-derived_links" ( link_id )', $index->{'sql'} );
}
sub check_triggers {
my $self = $_[0];
my $dbh = $self->{'store'}->_dbh();
my $trigger = $dbh->selectrow_hashref( q{SELECT * FROM sqlite_master WHERE name = 'dlf_test-derived_delete_trigger'} );
$self->assert_not_null( $trigger, "trigger dlf_test-derived_delete_trigger wasn't created" );
$self->assert_str_equals( "trigger", $trigger->{'type'} );
my $main_trigger_sql = <<EOS;
CREATE TRIGGER "dlf_test-derived_delete_trigger" AFTER DELETE ON dlf_test
BEGIN
DELETE FROM "dlf_test-derived_links" WHERE src_id = old.dlf_id;
END
EOS
chomp $main_trigger_sql;
$self->assert_str_equals( $main_trigger_sql, $trigger->{'sql'} );
$trigger = $dbh->selectrow_hashref( q{SELECT * FROM sqlite_master WHERE name = 'dlf_test-derived_links_delete_trigger'} );
$self->assert_not_null( $trigger, "trigger dlf_test-derived_links_delete_trigger wasn't created" );
$self->assert_str_equals( "trigger", $trigger->{'type'} );
my $link_trigger_sql = <<EOS;
CREATE TRIGGER "dlf_test-derived_links_delete_trigger" AFTER DELETE ON "dlf_test-derived"
BEGIN
DELETE FROM "dlf_test-derived_links" WHERE src_id = old.dlf_id;
END
EOS
chomp $link_trigger_sql;
$self->assert_str_equals( $link_trigger_sql, $trigger->{'sql'} );
}
1;
syntax highlighted by Code2HTML, v. 0.9.1