t/86sqlt.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use lib qw(t/lib);
   6 use DBICTest;
   7
   8 eval "use SQL::Translator";
   9 plan skip_all => 'SQL::Translator required' if $@;
  10
  11 my $schema = DBICTest->init_schema;
  12
  13 plan tests => 53;
  14
  15 my $translator = SQL::Translator->new(
  16   parser_args => {
  17     'DBIx::Schema' => $schema,
  18   },
  19   producer_args => {},
  20 );
  21
  22 $translator->parser('SQL::Translator::Parser::DBIx::Class');
  23 $translator->producer('SQLite');
  24
  25 my $output = $translator->translate();
  26
  27 # Note that the constraints listed here are the only ones that are tested -- if
  28 # more exist in the Schema than are listed here and all listed constraints are
  29 # correct, the test will still pass. If you add a class to DBICTest::Schema,
  30 # add tests here if you think the existing test coverage is not sufficient
  31
  32 my %fk_constraints = (
  33
  34   # TwoKeys
  35   twokeys => [
  36     {
  37       'display' => 'twokeys->cd',
  38       'selftable' => 'twokeys', 'foreigntable' => 'cd',
  39       'selfcols'  => ['cd'], 'foreigncols' => ['cdid'],
  40       on_delete => '', on_update => '',
  41     },
  42     {
  43       'display' => 'twokeys->artist',
  44       'selftable' => 'twokeys', 'foreigntable' => 'artist',
  45       'selfcols'  => ['artist'], 'foreigncols' => ['artistid'],
  46       on_delete => 'CASCADE', on_update => 'CASCADE',
  47     },
  48   ],
  49
  50   # FourKeys_to_TwoKeys
  51   fourkeys_to_twokeys => [
  52     {
  53       'display' => 'fourkeys_to_twokeys->twokeys',
  54       'selftable' => 'fourkeys_to_twokeys', 'foreigntable' => 'twokeys',
  55       'selfcols'  => ['t_artist', 't_cd'], 'foreigncols' => ['artist', 'cd'],
  56       on_delete => 'CASCADE', on_update => 'CASCADE',
  57     },
  58     {
  59       'display' => 'fourkeys_to_twokeys->fourkeys',
  60       'selftable' => 'fourkeys_to_twokeys', 'foreigntable' => 'fourkeys',
  61       'selfcols'  => [qw(f_foo f_bar f_hello f_goodbye)],
  62       'foreigncols' => [qw(foo bar hello goodbye)],
  63       on_delete => 'CASCADE', on_update => 'CASCADE',
  64     },
  65   ],
  66
  67   # CD_to_Producer
  68   cd_to_producer => [
  69     {
  70       'display' => 'cd_to_producer->cd',
  71       'selftable' => 'cd_to_producer', 'foreigntable' => 'cd',
  72       'selfcols'  => ['cd'], 'foreigncols' => ['cdid'],
  73       on_delete => 'CASCADE', on_update => 'CASCADE',
  74     },
  75     {
  76       'display' => 'cd_to_producer->producer',
  77       'selftable' => 'cd_to_producer', 'foreigntable' => 'producer',
  78       'selfcols'  => ['producer'], 'foreigncols' => ['producerid'],
  79       on_delete => '', on_update => '',
  80     },
  81   ],
  82
  83   # Self_ref_alias
  84   self_ref_alias => [
  85     {
  86       'display' => 'self_ref_alias->self_ref for self_ref',
  87       'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref',
  88       'selfcols'  => ['self_ref'], 'foreigncols' => ['id'],
  89       on_delete => 'CASCADE', on_update => 'CASCADE',
  90     },
  91     {
  92       'display' => 'self_ref_alias->self_ref for alias',
  93       'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref',
  94       'selfcols'  => ['alias'], 'foreigncols' => ['id'],
  95       on_delete => '', on_update => '',
  96     },
  97   ],
  98
  99   # CD
 100   cd => [
 101     {
 102       'display' => 'cd->artist',
 103       'selftable' => 'cd', 'foreigntable' => 'artist',
 104       'selfcols'  => ['artist'], 'foreigncols' => ['artistid'],
 105       on_delete => 'CASCADE', on_update => 'CASCADE',
 106     },
 107   ],
 108
 109   # Artist_undirected_map
 110   artist_undirected_map => [
 111     {
 112       'display' => 'artist_undirected_map->artist for id1',
 113       'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
 114       'selfcols'  => ['id1'], 'foreigncols' => ['artistid'],
 115       on_delete => 'CASCADE', on_update => '',
 116     },
 117     {
 118       'display' => 'artist_undirected_map->artist for id2',
 119       'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
 120       'selfcols'  => ['id2'], 'foreigncols' => ['artistid'],
 121       on_delete => 'CASCADE', on_update => '',
 122     },
 123   ],
 124
 125   # Track
 126   track => [
 127     {
 128       'display' => 'track->cd',
 129       'selftable' => 'track', 'foreigntable' => 'cd',
 130       'selfcols'  => ['cd'], 'foreigncols' => ['cdid'],
 131       on_delete => 'CASCADE', on_update => 'CASCADE',
 132     },
 133   ],
 134
 135   # TreeLike
 136   treelike => [
 137     {
 138       'display' => 'treelike->treelike for parent',
 139       'selftable' => 'treelike', 'foreigntable' => 'treelike',
 140       'selfcols'  => ['parent'], 'foreigncols' => ['id'],
 141       on_delete => '', on_update => '',
 142     },
 143   ],
 144
 145   # TwoKeyTreeLike
 146   twokeytreelike => [
 147     {
 148       'display' => 'twokeytreelike->twokeytreelike for parent1,parent2',
 149       'selftable' => 'twokeytreelike', 'foreigntable' => 'twokeytreelike',
 150       'selfcols'  => ['parent1', 'parent2'], 'foreigncols' => ['id1','id2'],
 151       on_delete => '', on_update => '',
 152     },
 153   ],
 154
 155   # Tags
 156   tags => [
 157     {
 158       'display' => 'tags->cd',
 159       'selftable' => 'tags', 'foreigntable' => 'cd',
 160       'selfcols'  => ['cd'], 'foreigncols' => ['cdid'],
 161       on_delete => 'CASCADE', on_update => 'CASCADE',
 162     },
 163   ],
 164
 165   # Bookmark
 166   bookmark => [
 167     {
 168       'display' => 'bookmark->link',
 169       'selftable' => 'bookmark', 'foreigntable' => 'link',
 170       'selfcols'  => ['link'], 'foreigncols' => ['id'],
 171       on_delete => '', on_update => '',
 172     },
 173   ],
 174 );
 175
 176 my %unique_constraints = (
 177   # CD
 178   cd => [
 179     {
 180       'display' => 'cd artist and title unique',
 181       'table' => 'cd', 'cols' => ['artist', 'title'],
 182     },
 183   ],
 184
 185   # Producer
 186   producer => [
 187     {
 188       'display' => 'producer name unique',
 189       'table' => 'producer', 'cols' => ['name'],
 190     },
 191   ],
 192
 193   # TwoKeyTreeLike
 194   twokeytreelike => [
 195     {
 196       'display' => 'twokeytreelike name unique',
 197       'table' => 'twokeytreelike', 'cols'  => ['name'],
 198     },
 199   ],
 200
 201   # Employee
 202 # Constraint is commented out in DBICTest/Schema/Employee.pm
 203 #  employee => [
 204 #    {
 205 #      'display' => 'employee position and group_id unique',
 206 #      'table' => 'employee', cols => ['position', 'group_id'],
 207 #    },
 208 #  ],
 209 );
 210
 211 my $tschema = $translator->schema();
 212
 213 # Test that nonexistent constraints are not found
 214 my $constraint = get_constraint('FOREIGN KEY', 'cd', ['title'], 'cd', ['year']);
 215 ok( !defined($constraint), 'nonexistent FOREIGN KEY constraint not found' );
 216 $constraint = get_constraint('UNIQUE', 'cd', ['artist']);
 217 ok( !defined($constraint), 'nonexistent UNIQUE constraint not found' );
 218
 219 for my $expected_constraints (keys %fk_constraints) {
 220   for my $expected_constraint (@{ $fk_constraints{$expected_constraints} }) {
 221     my $desc = $expected_constraint->{display};
 222     my $constraint = get_constraint(
 223       'FOREIGN KEY',
 224       $expected_constraint->{selftable}, $expected_constraint->{selfcols},
 225       $expected_constraint->{foreigntable}, $expected_constraint->{foreigncols},
 226     );
 227     ok( defined($constraint), "FOREIGN KEY constraint matching `$desc' found" );
 228     test_fk($expected_constraint, $constraint);
 229   }
 230 }
 231
 232 for my $expected_constraints (keys %unique_constraints) {
 233   for my $expected_constraint (@{ $unique_constraints{$expected_constraints} }) {
 234     my $desc = $expected_constraint->{display};
 235     my $constraint = get_constraint(
 236       'UNIQUE', $expected_constraint->{table}, $expected_constraint->{cols},
 237     );
 238     ok( defined($constraint), "UNIQUE constraint matching `$desc' found" );
 239   }
 240 }
 241
 242 # Returns the Constraint object for the specified constraint type, table and
 243 # columns from the SQL::Translator schema, or undef if no matching constraint
 244 # is found.
 245 #
 246 # NB: $type is either 'FOREIGN KEY' or 'UNIQUE'. In UNIQUE constraints the last
 247 # two parameters are not used.
 248 sub get_constraint {
 249   my ($type, $table_name, $cols, $f_table, $f_cols) = @_;
 250   $f_table ||= ''; # For UNIQUE constraints, reference_table is ''
 251   $f_cols ||= [];
 252
 253   my $table = $tschema->get_table($table_name);
 254
 255   my %fields = map { $_ => 1 } @$cols;
 256   my %f_fields = map { $_ => 1 } @$f_cols;
 257
 258  CONSTRAINT:
 259   for my $constraint ( $table->get_constraints ) {
 260     next unless $constraint->type eq $type;
 261     next unless $constraint->reference_table eq $f_table;
 262
 263     my %rev_fields = map { $_ => 1 } $constraint->fields;
 264     my %rev_f_fields = map { $_ => 1 } $constraint->reference_fields;
 265
 266     # Check that the given fields are a subset of the constraint's fields
 267     for my $field ($constraint->fields) {
 268       next CONSTRAINT unless $fields{$field};
 269     }
 270     if ($type eq 'FOREIGN KEY') {
 271       for my $f_field ($constraint->reference_fields) {
 272         next CONSTRAINT unless $f_fields{$f_field};
 273       }
 274     }
 275
 276     # Check that the constraint's fields are a subset of the given fields
 277     for my $field (@$cols) {
 278       next CONSTRAINT unless $rev_fields{$field};
 279     }
 280     if ($type eq 'FOREIGN KEY') {
 281       for my $f_field (@$f_cols) {
 282         next CONSTRAINT unless $rev_f_fields{$f_field};
 283       }
 284     }
 285
 286     return $constraint; # everything passes, found the constraint
 287   }
 288   return undef; # didn't find a matching constraint
 289 }
 290
 291 # Test parameters in a FOREIGN KEY constraint other than columns
 292 sub test_fk {
 293   my ($expected, $got) = @_;
 294   my $desc = $expected->{display};
 295   is( $got->on_delete, $expected->{on_delete},
 296       "on_delete parameter correct for `$desc'" );
 297   is( $got->on_update, $expected->{on_update},
 298       "on_update parameter correct for `$desc'" );
 299 }