Merge 'trunk' into 'DBIx-Class-current'
[dbsrgits/DBIx-Class-Historic.git] / t / helperrels / 26sqlt.t
1 use Test::More;
2 use lib qw(t/lib);
3 use DBICTest;
4 use DBICTest::HelperRels;
5
6 eval "use SQL::Translator";
7 plan skip_all => 'SQL::Translator required' if $@;
8
9 # do not taunt happy dave ball
10
11 my $schema = DBICTest::Schema;
12
13 plan tests => 33;
14
15 my $translator           =  SQL::Translator->new( 
16     parser_args          => {
17         'DBIx::Schema'   => $schema,
18     },
19     producer_args   => {
20     },
21 );
22
23 $translator->parser('SQL::Translator::Parser::DBIx::Class');
24 $translator->producer('SQLite');
25
26 my $output = $translator->translate();
27
28 my @fk_constraints = 
29  (
30   {'display' => 'twokeys->cd',
31    'selftable' => 'twokeys', 'foreigntable' => 'cd', 
32    'selfcols'  => ['cd'], 'foreigncols' => ['cdid'], 
33    'needed' => 1, on_delete => '', on_update => ''},
34   {'display' => 'twokeys->artist',
35    'selftable' => 'twokeys', 'foreigntable' => 'artist', 
36    'selfcols'  => ['artist'], 'foreigncols' => ['artistid'],
37    'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
38   {'display' => 'cd_to_producer->cd',
39    'selftable' => 'cd_to_producer', 'foreigntable' => 'cd', 
40    'selfcols'  => ['cd'], 'foreigncols' => ['cdid'],
41    'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
42   {'display' => 'cd_to_producer->producer',
43    'selftable' => 'cd_to_producer', 'foreigntable' => 'producer', 
44    'selfcols'  => ['producer'], 'foreigncols' => ['producerid'],
45    'needed' => 1, on_delete => '', on_update => ''},
46   {'display' => 'self_ref_alias -> self_ref for self_ref',
47    'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref', 
48    'selfcols'  => ['self_ref'], 'foreigncols' => ['id'],
49    'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
50   {'display' => 'self_ref_alias -> self_ref for alias',
51    'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref', 
52    'selfcols'  => ['alias'], 'foreigncols' => ['id'],
53    'needed' => 1, on_delete => '', on_update => ''},
54   {'display' => 'cd -> artist',
55    'selftable' => 'cd', 'foreigntable' => 'artist', 
56    'selfcols'  => ['artist'], 'foreigncols' => ['artistid'],
57    'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
58   {'display' => 'artist_undirected_map -> artist for id1',
59    'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', 
60    'selfcols'  => ['id1'], 'foreigncols' => ['artistid'],
61    'needed' => 1, on_delete => 'CASCADE', on_update => ''},
62   {'display' => 'artist_undirected_map -> artist for id2',
63    'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', 
64    'selfcols'  => ['id2'], 'foreigncols' => ['artistid'],
65    'needed' => 1, on_delete => 'CASCADE', on_update => ''},
66   {'display' => 'track->cd',
67    'selftable' => 'track', 'foreigntable' => 'cd', 
68    'selfcols'  => ['cd'], 'foreigncols' => ['cdid'],
69    'needed' => 2, on_delete => 'CASCADE', on_update => 'CASCADE'},
70   {'display' => 'treelike -> treelike for parent',
71    'selftable' => 'treelike', 'foreigntable' => 'treelike', 
72    'selfcols'  => ['parent'], 'foreigncols' => ['id'],
73    'needed' => 1, on_delete => '', on_update => ''},
74   {'display' => 'twokeytreelike -> twokeytreelike for parent1,parent2',
75    'selftable' => 'twokeytreelike', 'foreigntable' => 'twokeytreelike', 
76    'selfcols'  => ['parent1', 'parent2'], 'foreigncols' => ['id1','id2'],
77    'needed' => 1, on_delete => '', on_update => ''},
78   {'display' => 'tags -> cd',
79    'selftable' => 'tags', 'foreigntable' => 'cd', 
80    'selfcols'  => ['cd'], 'foreigncols' => ['cdid'],
81    'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'},
82   {'display' => 'bookmark -> link',
83    'selftable' => 'bookmark', 'foreigntable' => 'link', 
84    'selfcols'  => ['link'], 'foreigncols' => ['id'],
85    'needed' => 1, on_delete => '', on_update => ''},
86  );
87
88 my @unique_constraints = (
89   {'display' => 'cd artist and title unique',
90    'table' => 'cd', 'cols' => ['artist', 'title'],
91    'needed' => 1},
92   {'display' => 'twokeytreelike name unique',
93    'table' => 'twokeytreelike', 'cols'  => ['name'],
94    'needed' => 1},
95 #  {'display' => 'employee position and group_id unique',
96 #   'table' => 'employee', cols => ['position', 'group_id'],
97 #   'needed' => 1},
98 );
99
100 my $tschema = $translator->schema();
101 for my $table ($tschema->get_tables) {
102     my $table_name = $table->name;
103     for my $c ( $table->get_constraints ) {
104         if ($c->type eq 'FOREIGN KEY') {
105             ok(check_fk($table_name, scalar $c->fields, 
106                   $c->reference_table, scalar $c->reference_fields, 
107                   $c->on_delete, $c->on_update), "Foreign key constraint on $table_name matches an expected constraint");
108         }
109         elsif ($c->type eq 'UNIQUE') {
110             ok(check_unique($table_name, scalar $c->fields),
111                   "Unique constraint on $table_name matches an expected constraint");
112         }
113     }
114 }
115
116 # Make sure all the foreign keys are done.
117 my $i;
118 for ($i = 0; $i <= $#fk_constraints; ++$i) {
119  ok(!$fk_constraints[$i]->{'needed'}, "Constraint $fk_constraints[$i]->{display}");
120 }
121 # Make sure all the uniques are done.
122 for ($i = 0; $i <= $#unique_constraints; ++$i) {
123  ok(!$unique_constraints[$i]->{'needed'}, "Constraint $unique_constraints[$i]->{display}");
124 }
125
126 sub check_fk {
127  my ($selftable, $selfcol, $foreigntable, $foreigncol, $ondel, $onupd) = @_;
128
129  $ondel = '' if (!defined($ondel));
130  $onupd = '' if (!defined($onupd));
131
132  my $i;
133  for ($i = 0; $i <= $#fk_constraints; ++$i) {
134      if ($selftable eq $fk_constraints[$i]->{'selftable'} &&
135          $foreigntable eq $fk_constraints[$i]->{'foreigntable'} &&
136          ($ondel eq $fk_constraints[$i]->{on_delete}) &&
137          ($onupd eq $fk_constraints[$i]->{on_update})) {
138          # check columns
139
140          my $found = 0;
141          for (my $j = 0; $j <= $#$selfcol; ++$j) {
142              $found = 0;
143              for (my $k = 0; $k <= $#{$fk_constraints[$i]->{'selfcols'}}; ++$k) {
144                  if ($selfcol->[$j] eq $fk_constraints[$i]->{'selfcols'}->[$k] &&
145                      $foreigncol->[$j] eq $fk_constraints[$i]->{'foreigncols'}->[$k]) {
146                      $found = 1;
147                      last;
148                  }
149              }
150              last unless $found;
151          }
152
153          if ($found) {
154              for (my $j = 0; $j <= $#{$fk_constraints[$i]->{'selfcols'}}; ++$j) {
155                  $found = 0;
156                  for (my $k = 0; $k <= $#$selfcol; ++$k) {
157                      if ($selfcol->[$k] eq $fk_constraints[$i]->{'selfcols'}->[$j] &&
158                          $foreigncol->[$k] eq $fk_constraints[$i]->{'foreigncols'}->[$j]) {
159                          $found = 1;
160                          last;
161                      }
162                  }
163                  last unless $found;
164              }
165          }
166
167          if ($found) {
168              --$fk_constraints[$i]->{needed};
169              return 1;
170          }
171      }
172  }
173  return 0;
174 }
175
176 sub check_unique {
177  my ($selftable, $selfcol) = @_;
178
179  $ondel = '' if (!defined($ondel));
180  $onupd = '' if (!defined($onupd));
181
182  my $i;
183  for ($i = 0; $i <= $#unique_constraints; ++$i) {
184      if ($selftable eq $unique_constraints[$i]->{'table'}) {
185
186          my $found = 0;
187          for (my $j = 0; $j <= $#$selfcol; ++$j) {
188              $found = 0;
189              for (my $k = 0; $k <= $#{$unique_constraints[$i]->{'cols'}}; ++$k) {
190                  if ($selfcol->[$j] eq $unique_constraints[$i]->{'cols'}->[$k]) {
191                      $found = 1;
192                      last;
193                  }
194              }
195              last unless $found;
196          }
197
198          if ($found) {
199              for (my $j = 0; $j <= $#{$unique_constraints[$i]->{'cols'}}; ++$j) {
200                  $found = 0;
201                  for (my $k = 0; $k <= $#$selfcol; ++$k) {
202                      if ($selfcol->[$k] eq $unique_constraints[$i]->{'cols'}->[$j]) {
203                          $found = 1;
204                          last;
205                      }
206                  }
207                  last unless $found;
208              }
209          }
210
211          if ($found) {
212              --$unique_constraints[$i]->{needed};
213              return 1;
214          }
215      }
216  }
217  return 0;
218 }