dclone pod take #2
[dbsrgits/DBIx-Class.git] / t / 99dbic_sqlt_parser.t
CommitLineData
0e2c6809 1#!/usr/bin/perl
2use strict;
3use warnings;
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{
27 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
28
181c0934 29 foreach my $source (@sources) {
c2b7c5dc 30 my $table = get_table($sqlt_schema, $schema, $source);
0e2c6809 31
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
0e2c6809 36 is($index_count, $fk_count, "correct number of indices for $source with no args");
37 }
38}
39
40{
41 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } });
42
181c0934 43 foreach my $source (@sources) {
c2b7c5dc 44 my $table = get_table($sqlt_schema, $schema, $source);
0e2c6809 45
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
0e2c6809 50 is($index_count, $fk_count, "correct number of indices for $source with add_fk_index => 1");
51 }
52}
53
54{
55 my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } });
56
181c0934 57 foreach my $source (@sources) {
c2b7c5dc 58 my $table = get_table($sqlt_schema, $schema, $source);
0e2c6809 59
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 }
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
7f6f5b69 87done_testing;
88
0e2c6809 89sub create_schema {
90 my $args = shift;
91
92 my $schema = $args->{schema};
93 my $additional_sqltargs = $args->{args} || {};
94
95 my $sqltargs = {
96 add_drop_table => 1,
97 ignore_constraint_names => 1,
98 ignore_index_names => 1,
99 %{$additional_sqltargs}
100 };
101
102 my $sqlt = SQL::Translator->new( $sqltargs );
103
104 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
ab7e74aa 105 return $sqlt->translate({ data => $schema }) || die $sqlt->error;
0e2c6809 106}
c2b7c5dc 107
108sub get_table {
109 my ($sqlt_schema, $schema, $source) = @_;
110
111 my $table_name = $schema->source($source)->from;
112 $table_name = $$table_name if ref $table_name;
113
114 return $sqlt_schema->get_table($table_name);
115}