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