Fix RT52812
[dbsrgits/DBIx-Class.git] / t / 99dbic_sqlt_parser.t
CommitLineData
0e2c6809 1use strict;
2use warnings;
206d1995 3
0e2c6809 4use Test::More;
8fd10683 5use Test::Exception;
0e2c6809 6use lib qw(t/lib);
7use DBICTest;
8
9BEGIN {
b2b2e7fd 10 require DBIx::Class::Storage::DBI;
7f6f5b69 11 plan skip_all =>
b2b2e7fd 12 'Test needs SQL::Translator ' . DBIx::Class::Storage::DBI->_sqlt_minimum_version
13 if not DBIx::Class::Storage::DBI->_sqlt_version_ok;
0e2c6809 14}
15
16my $schema = DBICTest->init_schema();
0fc7cd47 17# Dummy was yanked out by the sqlt hook test
8e8a8d91 18# CustomSql tests the horrific/deprecated ->name(\$sql) hack
e0cd97a4 19# YearXXXXCDs are views
8e8a8d91 20#
21my @sources = grep
d6c322f8 22 { $_ !~ /^ (?: Dummy | CustomSql | Year\d{4}CDs ) $/x }
8e8a8d91 23 $schema->sources
24;
0fc7cd47 25
0e2c6809 26{
206d1995 27 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
0e2c6809 28
206d1995 29 foreach my $source (@sources) {
30 my $table = get_table($sqlt_schema, $schema, $source);
0e2c6809 31
206d1995 32 my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
33 my @indices = $table->get_indices;
34 my $index_count = scalar(@indices);
2581038c 35 $index_count++ if ($source eq 'TwoKeys'); # TwoKeys has the index turned off on the rel def
206d1995 36 is($index_count, $fk_count, "correct number of indices for $source with no args");
37 }
0e2c6809 38}
39
40{
206d1995 41 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } });
0e2c6809 42
206d1995 43 foreach my $source (@sources) {
44 my $table = get_table($sqlt_schema, $schema, $source);
0e2c6809 45
206d1995 46 my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
47 my @indices = $table->get_indices;
48 my $index_count = scalar(@indices);
2581038c 49 $index_count++ if ($source eq 'TwoKeys'); # TwoKeys has the index turned off on the rel def
206d1995 50 is($index_count, $fk_count, "correct number of indices for $source with add_fk_index => 1");
51 }
0e2c6809 52}
53
54{
206d1995 55 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } });
0e2c6809 56
206d1995 57 foreach my $source (@sources) {
58 my $table = get_table($sqlt_schema, $schema, $source);
0e2c6809 59
206d1995 60 my @indices = $table->get_indices;
61 my $index_count = scalar(@indices);
62 is($index_count, 0, "correct number of indices for $source with add_fk_index => 0");
63 }
0e2c6809 64}
65
8f1617e2 66{
ab7e74aa 67 {
68 package # hide from PAUSE
69 DBICTest::Schema::NoViewDefinition;
70
71 use base qw/DBICTest::BaseResult/;
8f1617e2 72
ab7e74aa 73 __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
74 __PACKAGE__->table('noviewdefinition');
8f1617e2 75
ab7e74aa 76 1;
8f1617e2 77 }
78
ab7e74aa 79 my $schema_invalid_view = $schema->clone;
80 $schema_invalid_view->register_class('NoViewDefinition', 'DBICTest::Schema::NoViewDefinition');
8f1617e2 81
8fd10683 82 throws_ok { create_schema({ schema => $schema_invalid_view }) }
83 qr/view noviewdefinition is missing a view_definition/,
84 'parser detects views with a view_definition';
8f1617e2 85}
86
a7f4b74c 87lives_ok (sub {
88 my $sqlt_schema = create_schema ({
89 schema => $schema,
90 args => {
91 parser_args => {
92 sources => ['CD']
93 },
94 },
95 });
96
97 is_deeply (
98 [$sqlt_schema->get_tables ],
99 ['cd'],
100 'sources limitng with relationships works',
101 );
102
103});
104
7f6f5b69 105done_testing;
106
0e2c6809 107sub create_schema {
206d1995 108 my $args = shift;
0e2c6809 109
206d1995 110 my $schema = $args->{schema};
111 my $additional_sqltargs = $args->{args} || {};
0e2c6809 112
206d1995 113 my $sqltargs = {
114 add_drop_table => 1,
115 ignore_constraint_names => 1,
116 ignore_index_names => 1,
117 %{$additional_sqltargs}
118 };
0e2c6809 119
206d1995 120 my $sqlt = SQL::Translator->new( $sqltargs );
0e2c6809 121
206d1995 122 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
123 return $sqlt->translate({ data => $schema }) || die $sqlt->error;
0e2c6809 124}
c2b7c5dc 125
126sub get_table {
127 my ($sqlt_schema, $schema, $source) = @_;
128
129 my $table_name = $schema->source($source)->from;
130 $table_name = $$table_name if ref $table_name;
131
132 return $sqlt_schema->get_table($table_name);
133}