package tests::DlfSchemaTest;
use strict;
use base qw/Test::Unit::TestSuite/;
sub name {
return "DlfSchema Tests";
}
sub include_tests {
return qw/tests::DlfSchemaTestBase tests::DlfSchemaTestI18N /;
}
package tests::DlfSchemaTestBase;
use base qw/ Lire::Test::TestCase /;
use Lire::DlfSchema;
use Lire::DerivedSchema;
use Lire::ExtendedSchema;
use Lire::Field;
use Lire::DlfStore;
use Lire::Utils qw/tempdir/;
my $test_schema = <<EOF;
<lire:dlf-schema superservice="test" timestamp="time_start"
xmlns:lire="http://www.logreport.org/LDSML/">
<lire:field name="time_start" type="timestamp"/>
<lire:field name="field-1" type="string"/>
<lire:field name="field_2" type="string"/>
<lire:field name="int_3" type="int"/>
<lire:field name="url_4" type="url"/>
</lire:dlf-schema>
EOF
sub new {
my $self = shift()->SUPER::new( @_ );
$self->{'tmpdir'} = tempdir( __PACKAGE__ . "XXXXXX",
'TMPDIR' => 1, CLEANUP => 1 );
$self->{'schemapath'} = $self->{'tmpdir'} . "/test.xml";
mkdir $self->{'tmpdir'} . "/schemas", 0755
or $self->error( "failed to make directory: $self->{'tmpdir'}/schemas" );
$self->create_schema( $test_schema, "test", $self->{'schemapath'} );
$self->create_schema( $test_schema, "test-exttest",
"$self->{'tmpdir'}/schemas/test-exttest.xml" );
return $self;
}
sub set_up {
my $self = $_[0];
$self->SUPER::set_up();
$self->{'cfg'}{'lr_schemas_path'} = [ $self->{'tmpdir'},
$self->{'tmpdir'} . "/schemas",
];
$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'};
$self->{'_old_cache'} = { %Lire::DlfSchema::SCHEMA_CACHE };
%Lire::DlfSchema::SCHEMA_CACHE = ();
return;
}
sub tear_down {
my $self = $_[0];
$self->SUPER::tear_down();
$self->{'store'}->_dbh()->rollback();
%Lire::DlfSchema::SCHEMA_CACHE = %{$self->{'_old_cache'}};
return;
}
sub create_schema {
my ( $self, $template, $name, $path ) = @_;
$template =~ s/superservice="test"/superservice="$name"/;
open my $fh, "> $path"
or die "can't create $name schema: $path: $!";
print $fh $template;
close $fh;
}
sub test_new {
my $self = $_[0];
my $schema = new Lire::DlfSchema( 'superservice' => 'test',
'timestamp' => 'a_field' );
$self->assert_isa( 'Lire::DlfSchema', $schema );
$self->assert_str_equals( 'test', $schema->{'id'} );
$self->assert_str_equals( 'test', $schema->{'superservice'} );
$self->assert_str_equals( 'a_field', $schema->{'timestamp_field'} );
$self->assert_num_equals( 2, scalar @{$schema->{'fields_by_pos'}} );
$self->assert( $schema->has_field( 'dlf_id' ), 'missing dlf_id' );
$self->assert( $schema->has_field( 'dlf_source' ), 'missing dlf_source' );
my $dlf_id = $schema->field( 'dlf_id' );
$self->assert_str_equals( 'id', $dlf_id->type() );
$self->assert_not_null( $dlf_id->description(), 'missing description' );
my $dlf_source = $schema->field( 'dlf_source' );
$self->assert_str_equals( 'string', $dlf_source->type() );
$self->assert_not_null( $dlf_source->description(),
'missing description' );
}
sub test_add_field {
my $self = $_[0];
my $schema = new Lire::DlfSchema( 'superservice' => 'test',
'timestamp' => 'a_field' );
my $field = new Lire::Field( 'name' => 'field', 'type' => 'string' );
$schema->add_field( $field );
$self->assert_str_equals( $field, $schema->{'fields_by_pos'}[-1] );
$self->assert_str_equals( $field, $schema->{'fields_by_name'}{'field'} );
$self->assert_num_equals( $#{$schema->{'fields_by_pos'}}, $field->pos() );
}
sub test_schema_load {
my $self = $_[0];
my $or_schema = Lire::DlfSchema::load_schema( "test" );
$self->assert_isa( 'Lire::DlfSchema', $or_schema );
$self->assert_str_equals( $or_schema,
$Lire::DlfSchema::SCHEMA_CACHE{'test'} );
# Should return cached copy
my $schema = Lire::DlfSchema::load_schema( "test" );
$self->assert_str_equals( $or_schema, $schema );
my $test2 = $Lire::DlfSchema::SCHEMA_CACHE{'test2'} =
new Lire::DlfSchema( 'superservice' => 'test2',
'timestamp' => 'time' );
$self->assert_str_equals( $test2,
Lire::DlfSchema::load_schema( 'test2' ) );
return;
}
sub test_has_schema {
my $self = $_[0];
$self->assert( Lire::DlfSchema->has_schema( "test"),
"has_schema( 'test' ) failed" );
$self->assert( Lire::DlfSchema->has_schema( "test-exttest"),
"has_schema( 'test-exttest' ) failed" );
$self->assert( ! Lire::DlfSchema->has_schema( "test2"),
"has_schema( 'test2' ) failed" );
$Lire::DlfSchema::SCHEMA_CACHE{'test-another'} = {};
$self->assert( Lire::DlfSchema->has_schema( 'test-another' ),
'has_schema should look into cache' );
$self->assert_dies( qr/missing 'schema_name' parameter/,
sub { Lire::DlfSchema->has_schema() } );
$self->assert_dies( qr/invalid schema name/,
sub { Lire::DlfSchema->has_schema( "../test" ) } );
}
sub test_has_superservice {
my $self = $_[0];
$self->assert( Lire::DlfSchema->has_superservice( "test" ),
"has_schema( 'test' ) failed" );
$self->assert( ! Lire::DlfSchema->has_superservice( "test2" ),
"has_schema( 'test2' ) should have failed" );
$Lire::DlfSchema::SCHEMA_CACHE{'test2'} = {};
$self->assert( Lire::DlfSchema->has_superservice( 'test2' ),
'has_schema should look into cache' );
$self->assert_died( sub { Lire::DlfSchema->has_superservice() },
qr/missing 'superservice' parameter/ );
$self->assert_dies( qr/invalid superservice schema name/,
sub { Lire::DlfSchema->has_superservice( "test-exttest" ) } );
$self->assert_dies( qr/invalid superservice schema name/,
sub { Lire::DlfSchema->has_superservice( "../test" ) } );
}
sub test_superservices {
my $self = $_[0];
my @super = Lire::DlfSchema->superservices();
$self->assert_deep_equals( [ "test" ], \@super );
}
sub test_schemas {
my $self = $_[0];
$Lire::DlfSchema::SCHEMA_CACHE{'test2'} = {};
my @schemas = Lire::DlfSchema->schemas();
$self->assert_deep_equals( [ "test2", "test", "test-exttest" ], \@schemas );
}
sub test_can_join_schema {
my $self = $_[0];
$self->set_up_fake_test_schema();
$Lire::DlfSchema::SCHEMA_CACHE{'test'} = $self->{'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 $ext1 = new Lire::ExtendedSchema( 'id' => 'test-ext1',
'base-schema' => 'test',
'module' => 'MyModule' );
my $ext2 = new Lire::ExtendedSchema( 'id' => 'test2-ext1',
'base-schema' => 'test2',
'module' => 'MyModule' );
my $derived = new Lire::DerivedSchema( 'id' => 'test-derived',
'base-schema' => 'test',
'timestamp' => 'time',
'module' => 'MyModule' );
$self->assert( $self->{'test'}->can_join_schema( $ext1 ) );
$self->assert( ! $self->{'test'}->can_join_schema( $self->{'test'} ) );
$self->assert( ! $self->{'test'}->can_join_schema( $ext2 ) );
$self->assert( ! $self->{'test'}->can_join_schema( $test2 ) );
$self->assert( ! $self->{'test'}->can_join_schema( $derived ) );
}
sub test__sql_fields_def {
my $self = $_[0];
my $test_sql_fields_def = <<EOS;
(
dlf_id INTEGER PRIMARY KEY,
dlf_source VARCHAR(512),
time_start TIMESTAMP,
"field-1" VARCHAR(512),
field_2 VARCHAR(512),
int_3 NUMBER(10,0),
url_4 VARCHAR(512)
)
EOS
my $schema = Lire::DlfSchema::load_schema( "test" );
$self->assert_str_equals( $test_sql_fields_def,
$schema->_sql_fields_def()
);
}
sub set_up_fake_test_schema {
my $self = $_[0];
$self->{'test'} = new Lire::DlfSchema( 'superservice' => 'test',
'timestamp' => 'time_start' );
$self->{'test'}->add_field( new Lire::Field( 'name' => 'time_start',
'type' => 'timestamp' ) );
$self->{'test'}->add_field( new Lire::Field( 'name' => 'field-1',
'type' => 'string' ) );
$self->{'test'}->add_field( new Lire::Field( 'name' => 'field_2',
'type' => 'string' ) );
$self->{'test'}->add_field( new Lire::Field( 'name' => 'int_3',
'type' => 'int' ) );
return;
}
sub set_up_old_test_stream {
my $self = $_[0];
$self->{'store'}->_dbh()->do( 'CREATE TABLE dlf_test ( time_start TIMESTAMP, field_removed VARCHAR(100), int_3 NUMBER(10,0) )' );
my $sth = $self->{'store'}{'_dbh'}->prepare( 'INSERT INTO dlf_test VALUES ( ?, ?, ? )' );
$self->{'dlf'} = [ { 'time_start' => time,
'int_3' => 10 },
{ 'time_start' => time + 10,
'int_3' => undef },
{ 'time_start' => time + 100,
'int_3' => -10 },
{ 'time_start' => time + 50,
'int_3' => 3 },
];
foreach my $dlf ( @{$self->{'dlf'}} ) {
$sth->execute( $dlf->{'time_start'}, 'Anything', $dlf->{'int_3'} );
}
return;
}
sub test_sql_table {
my $self = $_[0];
$self->set_up_fake_test_schema();
$self->assert_str_equals( 'dlf_test', $self->{'test'}->sql_table() );
$self->assert_str_equals( 'temp_dlf_test',
$self->{'test'}->sql_table( 'temp_' ) );
$self->assert_str_equals( 'temp_dlf_test_idx',
$self->{'test'}->sql_table( 'temp_', '_idx' ) );
$self->assert_str_equals( 'dlf_test_idx',
$self->{'test'}->sql_table( undef, '_idx'));
$self->assert_str_equals( '"temp-dlf_test"',
$self->{'test'}->sql_table( "temp-" ) );
$self->assert_str_equals( '"dlf_test:idx"',
$self->{'test'}->sql_table( undef, ":idx" ) );
$self->{'test'}{'id'} = 'test-extended';
$self->assert_equals( '"dlf_test-extended"',
$self->{'test'}->sql_table() );
}
sub test_create_sql_schema {
my $self = $_[0];
$self->set_up_fake_test_schema();
$self->{'test'}->create_sql_schema( $self->{'store'} );
my $sql_def = $self->{'test'}->_sql_fields_def();
chomp $sql_def; # Trailing newline removed by SQLite
my $dbh = $self->{'store'}->_dbh();
my $table = $dbh->selectrow_hashref( "SELECT * FROM sqlite_master WHERE name = 'dlf_test'" );
$self->assert_not_null( $table, "table dlf_test wasn't created" );
$self->assert_matches( qr/\Q$sql_def\E/, $table->{'sql'} );
my $index = $dbh->selectrow_hashref( "SELECT * FROM sqlite_master WHERE name = 'dlf_test_time_start_idx'" );
$self->assert_not_null( $index, "index dlf_test_time_start_idx wasn't created" );
$self->assert_equals( "index", $index->{'type'} );
$self->assert_equals( "CREATE INDEX dlf_test_time_start_idx ON dlf_test ( time_start )", $index->{'sql'} );
return;
}
sub test__migration_insert_query {
my $self = $_[0];
$self->set_up_fake_test_schema();
my $e_sql = "INSERT INTO dlf_test (time_start, \"field-1\", field_2, int_3) SELECT time_start, \"field-1\", field_2, int_3 FROM temp_dlf_test";
my $cfields = [ "time_start", "field-1", "field_2", "int_3"];
$self->assert_equals( $e_sql,
$self->{'test'}->_migration_insert_query( $cfields) );
}
sub test_needs_sql_schema_migration {
my $self = $_[0];
$self->set_up_fake_test_schema();
$self->assert( ! $self->{'test'}->needs_sql_schema_migration($self->{'store'}),
"no migration needed" );
$self->set_up_old_test_stream();
$self->assert( $self->{'test'}->needs_sql_schema_migration($self->{'store'}),
"migration required" );
}
sub test_migrate_sql_schema {
my $self = $_[0];
$self->set_up_fake_test_schema();
$self->set_up_old_test_stream();
$self->{'test'}->migrate_sql_schema( $self->{'store'} );
my $records =
$self->{'store'}->_dbh()->selectall_hashref( 'SELECT * FROM dlf_test',
'dlf_id' );
my $e_records = {};
my $id = 1;
foreach my $dlf ( @{$self->{'dlf'}} ) {
$e_records->{$id} = { 'dlf_id' => $id,
'dlf_source' => undef,
'time_start' => $dlf->{'time_start'},
'field-1' => undef,
'field_2' => undef,
'int_3' => $dlf->{'int_3'} };
$id++;
}
$self->assert_deep_equals( $e_records, $records );
}
sub test_dlf_query {
my $self = $_[0];
$self->set_up_fake_test_schema();
my $query = $self->{'test'}->dlf_query( "-time_start field-1" );
$self->assert_isa( 'Lire::DlfQuery', $query );
$self->assert_str_equals( 'test', $query->stream_name() );
$self->assert_deep_equals( [], $query->aggr_fields() );
$self->assert_deep_equals( [], $query->group_fields() );
$self->assert_deep_equals( [ 'dlf_id', 'dlf_source', 'time_start',
'field-1', 'field_2', 'int_3' ],
$query->fields() );
$self->assert_str_equals( "time_start DESC, \"field-1\"",
$query->order_by_clause() );
}
sub test_sql_insert_query {
my $self = $_[0];
$self->set_up_fake_test_schema();
my $e_sql = "INSERT INTO dlf_test (dlf_id, dlf_source, time_start, \"field-1\", field_2, int_3) VALUES (?,?,?,?,?,?)";
$self->assert_str_equals( $e_sql, $self->{'test'}->sql_insert_query() );
}
sub test_sql_clean_query {
my $self = $_[0];
$self->set_up_fake_test_schema();
$self->assert_str_equals( 'DELETE FROM dlf_test',
$self->{'test'}->sql_clean_query() );
$self->{'test'}{'timestamp_field'} = 'time-start';
$self->assert_str_equals( 'DELETE FROM dlf_test WHERE "time-start" < ?',
$self->{'test'}->sql_clean_query( 1 ) );
}
sub test_sql_clean_period_query {
my $self = $_[0];
$self->set_up_fake_test_schema();
$self->{'test'}{'timestamp_field'} = 'time-start';
$self->assert_str_equals( 'DELETE FROM dlf_test WHERE "time-start" >= ? AND "time-start" < ?',
$self->{'test'}->sql_clean_period_query() );
}
package tests::DlfSchemaTestI18N;
use base qw/Lire::Test::TestCase tests::TestStoreFixture /;
sub new {
my $self = shift()->SUPER::new( @_ );
$self->init();
$self->init_i18n();
return $self;
}
sub set_up {
my $self = $_[0];
$self->SUPER::set_up();
$self->set_up_test_schema();
# This has to be done before set_up_locale() otherwise
# the textdomain might be wrong (since first load of schema
# will set it to a non-existent directory
$self->{'schema'} = Lire::DlfSchema::load_schema( "test-extended" );
$self->set_up_locale();
return;
}
sub tear_down {
my $self = $_[0];
$self->SUPER::tear_down();
$self->tear_down_locale();
return;
}
sub test_title_i18n {
my $self = $_[0];
my $schema = $self->{'schema'};
$self->assert_str_equals( 'Simple Extended Schema for Tests',
$schema->title() );
$self->set_locale( 'fr_CA.iso8859-1' );
$self->assert_str_equals( "Définition simple d'un schéma étendu pour test",
$schema->title() );
}
sub test_description_i18n {
my $self = $_[0];
my $schema = $self->{'schema'};
local $schema->{'description'} = '<para>JPEG Files</para>';
$self->assert_str_equals( "<para>JPEG Files</para>",
$schema->description() );
$self->set_locale( 'fr_CA.iso8859-1' );
$self->assert_str_equals( "<para>Fichiers JPEG</para>",
$schema->description() );
}
1;
syntax highlighted by Code2HTML, v. 0.9.1