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