1use strict; 2use warnings; 3 4use Test::More; 5use Test::Exception; 6use lib qw(t/lib); 7use DBICTest; 8use DBICTest::Schema; 9use Scalar::Util (); 10 11BEGIN { 12 require DBIx::Class; 13 plan skip_all => 14 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') 15 unless DBIx::Class::Optional::Dependencies->req_ok_for ('deploy') 16} 17 18# Test for SQLT-related leaks 19{ 20 my $s = DBICTest::Schema->clone; 21 my $sqlt_schema = create_schema ({ schema => $s }); 22 Scalar::Util::weaken ($s); 23 24 ok (!$s, 'Schema not leaked'); 25 26 isa_ok ($sqlt_schema, 'SQL::Translator::Schema', 'SQLT schema object produced'); 27} 28 29# make sure classname-style works 30lives_ok { isa_ok (create_schema ({ schema => 'DBICTest::Schema' }), 'SQL::Translator::Schema', 'SQLT schema object produced') }; 31 32 33my $schema = DBICTest->init_schema(); 34# Dummy was yanked out by the sqlt hook test 35# CustomSql tests the horrific/deprecated ->name(\$sql) hack 36# YearXXXXCDs are views 37# 38my @sources = grep 39 { $_ !~ /^ (?: Dummy | CustomSql | Year\d{4}CDs ) $/x } 40 $schema->sources 41; 42 43my $idx_exceptions = { 44 'Artwork' => -1, 45 'ForceForeign' => -1, 46 'LinerNotes' => -1, 47 'TwoKeys' => -1, # TwoKeys has the index turned off on the rel def 48}; 49 50{ 51 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } }); 52 53 foreach my $source_name (@sources) { 54 my $table = get_table($sqlt_schema, $schema, $source_name); 55 56 my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints); 57 $fk_count += $idx_exceptions->{$source_name} || 0; 58 my @indices = $table->get_indices; 59 60 my $index_count = scalar(@indices); 61 is($index_count, $fk_count, "correct number of indices for $source_name with no args"); 62 63 for my $index (@indices) { 64 my $source = $schema->source($source_name); 65 my $pk_test = join("\x00", $source->primary_columns); 66 my $idx_test = join("\x00", $index->fields); 67 isnt ( $pk_test, $idx_test, "no additional index for the primary columns exists in $source_name"); 68 } 69 } 70} 71 72{ 73 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } }); 74 75 foreach my $source_name (@sources) { 76 my $table = get_table($sqlt_schema, $schema, $source_name); 77 78 my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints); 79 $fk_count += $idx_exceptions->{$source_name} || 0; 80 my @indices = $table->get_indices; 81 my $index_count = scalar(@indices); 82 is($index_count, $fk_count, "correct number of indices for $source_name with add_fk_index => 1"); 83 } 84} 85 86{ 87 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } }); 88 89 foreach my $source (@sources) { 90 my $table = get_table($sqlt_schema, $schema, $source); 91 92 my @indices = $table->get_indices; 93 my $index_count = scalar(@indices); 94 is($index_count, 0, "correct number of indices for $source with add_fk_index => 0"); 95 } 96} 97 98{ 99 { 100 package # hide from PAUSE 101 DBICTest::Schema::NoViewDefinition; 102 103 use base qw/DBICTest::BaseResult/; 104 105 __PACKAGE__->table_class('DBIx::Class::ResultSource::View'); 106 __PACKAGE__->table('noviewdefinition'); 107 108 1; 109 } 110 111 my $schema_invalid_view = $schema->clone; 112 $schema_invalid_view->register_class('NoViewDefinition', 'DBICTest::Schema::NoViewDefinition'); 113 114 throws_ok { create_schema({ schema => $schema_invalid_view }) } 115 qr/view noviewdefinition is missing a view_definition/, 116 'parser detects views with a view_definition'; 117} 118 119lives_ok (sub { 120 my $sqlt_schema = create_schema ({ 121 schema => $schema, 122 args => { 123 parser_args => { 124 sources => ['CD'] 125 }, 126 }, 127 }); 128 129 is_deeply ( 130 [$sqlt_schema->get_tables ], 131 ['cd'], 132 'sources limitng with relationships works', 133 ); 134 135}); 136 137done_testing; 138 139sub create_schema { 140 my $args = shift; 141 142 my $schema = $args->{schema}; 143 my $additional_sqltargs = $args->{args} || {}; 144 145 my $sqltargs = { 146 add_drop_table => 1, 147 ignore_constraint_names => 1, 148 ignore_index_names => 1, 149 %{$additional_sqltargs} 150 }; 151 152 my $sqlt = SQL::Translator->new( $sqltargs ); 153 154 $sqlt->parser('SQL::Translator::Parser::DBIx::Class'); 155 return $sqlt->translate({ data => $schema }) || die $sqlt->error; 156} 157 158sub get_table { 159 my ($sqlt_schema, $schema, $source) = @_; 160 161 my $table_name = $schema->source($source)->from; 162 $table_name = $$table_name if ref $table_name; 163 164 return $sqlt_schema->get_table($table_name); 165} 166