X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F86sqlt.t;h=3430cec8c3abe339ed601b61bea03f506cfca332;hb=4549ba4966c026a49409c7dde70f32b2512250b0;hp=8211c9046006c5cbac7f9b42627d424562fafd46;hpb=70c49125fbb6ace2022621dc429f2815407940d9;p=dbsrgits%2FDBIx-Class.git diff --git a/t/86sqlt.t b/t/86sqlt.t index 8211c90..3430cec 100644 --- a/t/86sqlt.t +++ b/t/86sqlt.t @@ -5,12 +5,81 @@ use Test::More; use lib qw(t/lib); use DBICTest; -eval "use SQL::Translator"; -plan skip_all => 'SQL::Translator required' if $@; +BEGIN { + require DBIx::Class; + plan skip_all => + 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') + unless DBIx::Class::Optional::Dependencies->req_ok_for ('deploy') +} + +my $custom_deployment_statements_called = 0; + +sub DBICTest::Schema::deployment_statements { + $custom_deployment_statements_called = 1; + my $self = shift; + return $self->next::method(@_); +} + +my $schema = DBICTest->init_schema (no_deploy => 1); + -my $schema = DBICTest->init_schema; +# Check deployment statements ctx sensitivity +{ + my $not_first_table_creation_re = qr/CREATE TABLE fourkeys_to_twokeys/; + + + my $statements = $schema->deployment_statements; + like ( + $statements, + $not_first_table_creation_re, + 'All create statements returned in 1 string in scalar ctx' + ); + + my @statements = $schema->deployment_statements; + cmp_ok (scalar @statements, '>', 1, 'Multiple statement lines in array ctx'); + + my $i = 0; + while ($i <= $#statements) { + last if $statements[$i] =~ $not_first_table_creation_re; + $i++; + } + + ok ( + ($i > 0) && ($i <= $#statements), + "Creation statement was found somewherere within array ($i)" + ); +} + + + +{ + my $deploy_hook_called = 0; + + # replace the sqlt calback with a custom version ading an index + $schema->source('Track')->sqlt_deploy_callback(sub { + my ($self, $sqlt_table) = @_; + + $deploy_hook_called = 1; + + is ( + $sqlt_table->schema->translator->producer_type, + join ('::', 'SQL::Translator::Producer', $schema->storage->sqlt_type), + 'Production type passed to translator object', + ); + + if ($schema->storage->sqlt_type eq 'SQLite' ) { + $sqlt_table->add_index( name => 'track_title', fields => ['title'] ) + or die $sqlt_table->error; + } + + $self->default_sqlt_deploy_hook($sqlt_table); + }); + + $schema->deploy; # do not remove, this fires the is() test in the callback above + ok($deploy_hook_called, 'deploy hook got called'); + ok($custom_deployment_statements_called, '->deploy used the schemas deploy_statements method'); +} -plan tests => 130; my $translator = SQL::Translator->new( parser_args => { @@ -19,14 +88,29 @@ my $translator = SQL::Translator->new( producer_args => {}, ); -$translator->parser('SQL::Translator::Parser::DBIx::Class'); -$translator->producer('SQLite'); +{ + my $warn = ''; + local $SIG{__WARN__} = sub { $warn = shift }; + + my $relinfo = $schema->source('Artist')->relationship_info ('cds'); + local $relinfo->{attrs}{on_delete} = 'restrict'; -my $output = $translator->translate(); + $translator->parser('SQL::Translator::Parser::DBIx::Class'); + $translator->producer('SQLite'); -ok($output, "SQLT produced someoutput") - or diag($translator->error); + my $output = $translator->translate(); + + ok($output, "SQLT produced someoutput") + or diag($translator->error); + + + like ( + $warn, + qr/SQLT attribute .+? was supplied for relationship .+? which does not appear to be a foreign constraint/, + 'Warn about dubious on_delete/on_update attributes', + ); +} # Note that the constraints listed here are the only ones that are tested -- if # more exist in the Schema than are listed here and all listed constraints are @@ -128,14 +212,14 @@ my %fk_constraints = ( 'name' => 'artist_undirected_map_fk_id1', 'index_name' => 'artist_undirected_map_idx_id1', 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', 'selfcols' => ['id1'], 'foreigncols' => ['artistid'], - on_delete => 'CASCADE', on_update => '', deferrable => 1, + on_delete => 'RESTRICT', on_update => 'CASCADE', deferrable => 1, }, { 'display' => 'artist_undirected_map->artist for id2', 'name' => 'artist_undirected_map_fk_id2', 'index_name' => 'artist_undirected_map_idx_id2', 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', 'selfcols' => ['id2'], 'foreigncols' => ['artistid'], - on_delete => 'CASCADE', on_update => '', deferrable => 1, + on_delete => '', on_update => '', deferrable => 1, }, ], @@ -190,7 +274,7 @@ my %fk_constraints = ( 'name' => 'bookmark_fk_link', 'index_name' => 'bookmark_idx_link', 'selftable' => 'bookmark', 'foreigntable' => 'link', 'selfcols' => ['link'], 'foreigncols' => ['id'], - on_delete => '', on_update => '', deferrable => 1, + on_delete => 'SET NULL', on_update => 'CASCADE', deferrable => 1, }, ], # ForceForeign @@ -200,10 +284,10 @@ my %fk_constraints = ( 'name' => 'forceforeign_fk_artist', 'index_name' => 'forceforeign_idx_artist', 'selftable' => 'forceforeign', 'foreigntable' => 'artist', 'selfcols' => ['artist'], 'foreigncols' => ['artistid'], + 'noindex' => 1, on_delete => '', on_update => '', deferrable => 1, }, ], - ); my %unique_constraints = ( @@ -250,7 +334,12 @@ my %indexes = ( { 'fields' => ['name'] }, - ] + ], + track => [ + { + 'fields' => ['title'] + } + ], ); my $tschema = $translator->schema(); @@ -258,6 +347,18 @@ my $tschema = $translator->schema(); # the 'dummy' table ok( !defined($tschema->get_table('dummy')), "Dummy table was removed by hook"); +# Test that the Artist resultsource sqlt_deploy_hook was called okay and added +# an index +SKIP: { + skip ('Artist sqlt_deploy_hook is only called with an SQLite backend', 1) + if $schema->storage->sqlt_type ne 'SQLite'; + + ok( ( grep + { $_->name eq 'artist_name_hookidx' } + $tschema->get_table('artist')->get_indices + ), 'sqlt_deploy_hook fired within a resultsource'); +} + # Test that nonexistent constraints are not found my $constraint = get_constraint('FOREIGN KEY', 'cd', ['title'], 'cd', ['year']); ok( !defined($constraint), 'nonexistent FOREIGN KEY constraint not found' ); @@ -292,7 +393,6 @@ for my $expected_constraints (keys %unique_constraints) { for my $table_index (keys %indexes) { for my $expected_index ( @{ $indexes{$table_index} } ) { - ok ( get_index($table_index, $expected_index), "Got a matching index on $table_index table"); } } @@ -380,21 +480,21 @@ sub test_fk { my ($expected, $got) = @_; my $desc = $expected->{display}; is( $got->name, $expected->{name}, - "name parameter correct for `$desc'" ); + "name parameter correct for '$desc'" ); is( $got->on_delete, $expected->{on_delete}, - "on_delete parameter correct for `$desc'" ); + "on_delete parameter correct for '$desc'" ); is( $got->on_update, $expected->{on_update}, - "on_update parameter correct for `$desc'" ); + "on_update parameter correct for '$desc'" ); is( $got->deferrable, $expected->{deferrable}, - "is_deferrable parameter correct for `$desc'" ); + "is_deferrable parameter correct for '$desc'" ); my $index = get_index( $got->table, { fields => $expected->{selfcols} } ); if ($expected->{noindex}) { - ok( !defined $index, "index doesn't for `$desc'" ); + ok( !defined $index, "index doesn't for '$desc'" ); } else { - ok( defined $index, "index exists for `$desc'" ); - is( $index->name, $expected->{index_name}, "index has correct name for `$desc'" ); + ok( defined $index, "index exists for '$desc'" ); + is( $index->name, $expected->{index_name}, "index has correct name for '$desc'" ); } } @@ -402,5 +502,7 @@ sub test_unique { my ($expected, $got) = @_; my $desc = $expected->{display}; is( $got->name, $expected->{name}, - "name parameter correct for `$desc'" ); + "name parameter correct for '$desc'" ); } + +done_testing;