projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Honor supplied field order when adding fields to a table object
[dbsrgits/SQL-Translator.git] / t / 13schema.t
CommitLineData
4d878d2f 1#!/usr/bin/perl
5dada97b 2# vim:set ft=perl:
4d878d2f 3
586fba3f 4$| = 1;
5
4d878d2f 6use strict;
807290c3 7use Test::More tests => 245;
8use Test::Exception;
07680493 9use SQL::Translator::Schema::Constants;
4d878d2f 10
10f36920 11require_ok( 'SQL::Translator' );
4d878d2f 12require_ok( 'SQL::Translator::Schema' );
13
07680493 14{
15 #
16 # Schema
17 #
aee4b66e 18 my $schema = SQL::Translator::Schema->new(
07680493 19 name => 'foo',
20 database => 'MySQL',
21 );
22 isa_ok( $schema, 'SQL::Translator::Schema' );
4d878d2f 23
07680493 24 is( $schema->name, 'foo', 'Schema name is "foo"' );
25 is( $schema->name('bar'), 'bar', 'Schema name changed to "bar"' );
4d878d2f 26
07680493 27 is( $schema->database, 'MySQL', 'Schema database is "MySQL"' );
aee4b66e 28 is( $schema->database('PostgreSQL'), 'PostgreSQL',
07680493 29 'Schema database changed to "PostgreSQL"' );
4d878d2f 30
07680493 31 is( $schema->is_valid, undef, 'Schema not valid...' );
32 like( $schema->error, qr/no tables/i, '...because there are no tables' );
4d878d2f 33
07680493 34 #
35 # $schema->add_*
36 #
37 my $foo_table = $schema->add_table(name => 'foo') or warn $schema->error;
38 isa_ok( $foo_table, 'SQL::Translator::Schema::Table', 'Table "foo"' );
4d878d2f 39
aee4b66e 40 my $bar_table = SQL::Translator::Schema::Table->new( name => 'bar' ) or
07680493 41 warn SQL::Translator::Schema::Table->error;
42 $bar_table = $schema->add_table( $bar_table );
43 isa_ok( $bar_table, 'SQL::Translator::Schema::Table', 'Table "bar"' );
44 is( $bar_table->name, 'bar', 'Add table "bar"' );
4d878d2f 45
07680493 46 $schema = $bar_table->schema( $schema );
47 isa_ok( $schema, 'SQL::Translator::Schema', 'Schema' );
4d878d2f 48
aee4b66e 49 is( $bar_table->name('foo'), undef,
07680493 50 q[Can't change name of table "bar" to "foo"...]);
aee4b66e 51 like( $bar_table->error, qr/can't use table name/i,
07680493 52 q[...because "foo" exists] );
4d878d2f 53
07680493 54 my $redundant_table = $schema->add_table(name => 'foo');
55 is( $redundant_table, undef, qq[Can't create another "foo" table...] );
aee4b66e 56 like( $schema->error, qr/can't use table name/i,
3166386a 57 '... because "foo" exists' );
07680493 58
5ab9f4fd 59 $redundant_table = $schema->add_table(name => '');
650f87eb 60 is( $redundant_table, undef, qq[Can't add an anonymous table...] );
5ab9f4fd 61 like( $schema->error, qr/No table name/i,
650f87eb 62 '... because it has no name ' );
5ab9f4fd 63
64 $redundant_table = SQL::Translator::Schema::Table->new(name => '');
650f87eb 65 is( $redundant_table, undef, qq[Can't create an anonymous table] );
5ab9f4fd 66 like( SQL::Translator::Schema::Table->error, qr/No table name/i,
650f87eb 67 '... because it has no name ' );
5ab9f4fd 68
07680493 69 #
650f87eb 70 # $schema-> drop_table
71 #
72 my $dropped_table = $schema->drop_table($foo_table->name, cascade => 1);
73 isa_ok($dropped_table, 'SQL::Translator::Schema::Table', 'Dropped table "foo"' );
74 $schema->add_table($foo_table);
75 my $dropped_table2 = $schema->drop_table($foo_table, cascade => 1);
76 isa_ok($dropped_table2, 'SQL::Translator::Schema::Table', 'Dropped table "foo" by object' );
77 my $dropped_table3 = $schema->drop_table($foo_table->name, cascade => 1);
78 like( $schema->error, qr/doesn't exist/, qq[Can't drop non-existant table "foo"] );
79
80 $schema->add_table($foo_table);
81 #
07680493 82 # Table default new
83 #
84 is( $foo_table->name, 'foo', 'Table name is "foo"' );
5ab9f4fd 85 is( "$foo_table", 'foo', 'Table stringifies to "foo"' );
07680493 86 is( $foo_table->is_valid, undef, 'Table "foo" is not yet valid' );
87
88 my $fields = $foo_table->get_fields;
89 is( scalar @{ $fields || [] }, 0, 'Table "foo" has no fields' );
90 like( $foo_table->error, qr/no fields/i, 'Error for no fields' );
91
7a7e9080 92 is( $foo_table->comments, undef, 'No comments' );
3166386a 93
07680493 94 #
95 # New table with args
96 #
aee4b66e 97 my $person_table = $schema->add_table(
98 name => 'person',
3166386a 99 comments => 'foo',
100 );
07680493 101 is( $person_table->name, 'person', 'Table name is "person"' );
102 is( $person_table->is_valid, undef, 'Table is not yet valid' );
3166386a 103 is( $person_table->comments, 'foo', 'Comments = "foo"' );
aee4b66e 104 is( join(',', $person_table->comments('bar')), 'foo,bar',
3166386a 105 'Table comments = "foo,bar"' );
106 is( $person_table->comments, "foo\nbar", 'Table comments = "foo,bar"' );
07680493 107
108 #
109 # Field default new
110 #
aee4b66e 111 my $f1 = $person_table->add_field(name => 'foo') or
07680493 112 warn $person_table->error;
113 isa_ok( $f1, 'SQL::Translator::Schema::Field', 'Field' );
114 is( $f1->name, 'foo', 'Field name is "foo"' );
4809213f 115 is( $f1->full_name, 'person.foo', 'Field full_name is "person.foo"' );
5ab9f4fd 116 is( "$f1", 'foo', 'Field stringifies to "foo"' );
07680493 117 is( $f1->data_type, '', 'Field data type is blank' );
118 is( $f1->size, 0, 'Field size is "0"' );
119 is( $f1->is_primary_key, '0', 'Field is_primary_key is false' );
14f8758f 120 is( $f1->is_nullable, 1, 'Field can be NULL' );
07680493 121 is( $f1->default_value, undef, 'Field default is undefined' );
3166386a 122 is( $f1->comments, '', 'No comments' );
57fd48f1 123 is( $f1->table, 'person', 'Field table is person' );
124 is( $f1->schema->database, 'PostgreSQL', 'Field schema shortcut works' );
07680493 125
3166386a 126 my $f2 = SQL::Translator::Schema::Field->new (
127 name => 'f2',
128 comments => 'foo',
129 ) or warn SQL::Translator::Schema::Field->error;
07680493 130 $f2 = $person_table->add_field( $f2 );
131 isa_ok( $f1, 'SQL::Translator::Schema::Field', 'f2' );
132 is( $f2->name, 'f2', 'Add field "f2"' );
14f8758f 133 is( $f2->is_nullable(0), 0, 'Field cannot be NULL' );
134 is( $f2->is_nullable(''), 0, 'Field cannot be NULL' );
135 is( $f2->is_nullable('0'), 0, 'Field cannot be NULL' );
3166386a 136 is( $f2->default_value(''), '', 'Field default is empty string' );
137 is( $f2->comments, 'foo', 'Field comment = "foo"' );
aee4b66e 138 is( join(',', $f2->comments('bar')), 'foo,bar',
3166386a 139 'Field comment = "foo,bar"' );
140 is( $f2->comments, "foo\nbar", 'Field comment = "foo,bar"' );
07680493 141
142 $person_table = $f2->table( $person_table );
143 isa_ok( $person_table, 'SQL::Translator::Schema::Table', 'person_table' );
144
145 is( $f2->name('foo'), undef, q[Can't set field name of "f2" to "foo"...] );
146 like( $f2->error, qr/can't use field name/i, '...because name exists' );
147
148 my $redundant_field = $person_table->add_field(name => 'f2');
149 is( $redundant_field, undef, qq[Didn't create another "f2" field...] );
aee4b66e 150 like( $person_table->error, qr/can't use field/i,
07680493 151 '... because it exists' );
152
5ab9f4fd 153 $redundant_field = $person_table->add_field(name => '');
154 is( $redundant_field, undef, qq[Didn't add a "" field...] );
155 like( $person_table->error, qr/No field name/i,
156 '... because it has no name' );
157
158 $redundant_field = SQL::Translator::Schema::Field->new(name => '');
159 is( $redundant_field, undef, qq[Didn't create a "" field...] );
160 like( SQL::Translator::Schema::Field->error, qr/No field name/i,
161 '... because it has no name' );
162
14f8758f 163 my @fields = $person_table->get_fields;
164 is( scalar @fields, 2, 'Table "foo" has 2 fields' );
165
166 is( $fields[0]->name, 'foo', 'First field is "foo"' );
167 is( $fields[1]->name, 'f2', 'Second field is "f2"' );
81e0fe82 168 is( join(",",$person_table->field_names), 'foo,f2',
169 'field_names is "foo,f2"' );
14f8758f 170
07680493 171 #
650f87eb 172 # $table-> drop_field
173 #
174 my $dropped_field = $person_table->drop_field($f2->name, cascade => 1);
175 isa_ok($dropped_field, 'SQL::Translator::Schema::Field', 'Dropped field "f2"' );
176 $person_table->add_field($f2);
177 my $dropped_field2 = $person_table->drop_field($f2, cascade => 1);
178 isa_ok($dropped_field2, 'SQL::Translator::Schema::Field', 'Dropped field "f2" by object' );
179 my $dropped_field3 = $person_table->drop_field($f2->name, cascade => 1);
180 like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant field "f2"] );
181
182 $person_table->add_field($f2);
183
184 #
07680493 185 # Field methods
186 #
5ab9f4fd 187 is( $f1->name('person_name'), 'person_name',
07680493 188 'Field name is "person_name"' );
189 is( $f1->data_type('varchar'), 'varchar', 'Field data type is "varchar"' );
190 is( $f1->size('30'), '30', 'Field size is "30"' );
191 is( $f1->is_primary_key(0), '0', 'Field is_primary_key is negative' );
192
adfdb552 193 $f1->extra( foo => 'bar' );
194 $f1->extra( { baz => 'quux' } );
195 my %extra = $f1->extra;
196 is( $extra{'foo'}, 'bar', 'Field extra "foo" is "bar"' );
197 is( $extra{'baz'}, 'quux', 'Field extra "baz" is "quux"' );
198
07680493 199 #
200 # New field with args
201 #
202 my $age = $person_table->add_field(
203 name => 'age',
204 data_type => 'float',
205 size => '10,2',
206 );
207 is( $age->name, 'age', 'Field name is "age"' );
208 is( $age->data_type, 'float', 'Field data type is "float"' );
209 is( $age->size, '10,2', 'Field size is "10,2"' );
210 is( $age->size(10,2), '10,2', 'Field size still "10,2"' );
211 is( $age->size([10,2]), '10,2', 'Field size still "10,2"' );
212 is( $age->size(qw[ 10 2 ]), '10,2', 'Field size still "10,2"' );
14f8758f 213 is( join(':', $age->size), '10:2', 'Field size returns array' );
07680493 214
215 #
216 # Index
217 #
218 my @indices = $person_table->get_indices;
219 is( scalar @indices, 0, 'No indices' );
220 like( $person_table->error, qr/no indices/i, 'Error for no indices' );
aee4b66e 221 my $index1 = $person_table->add_index( name => "foo" )
07680493 222 or warn $person_table->error;
223 isa_ok( $index1, 'SQL::Translator::Schema::Index', 'Index' );
224 is( $index1->name, 'foo', 'Index name is "foo"' );
225
14f8758f 226 is( $index1->is_valid, undef, 'Index name is not valid...' );
227 like( $index1->error, qr/no fields/i, '...because it has no fields' );
228
aee4b66e 229 is( join(':', $index1->fields('foo,bar')), 'foo:bar',
14f8758f 230 'Index accepts fields');
231
232 is( $index1->is_valid, undef, 'Index name is not valid...' );
aee4b66e 233 like( $index1->error, qr/does not exist in table/i,
14f8758f 234 '...because it used fields not in the table' );
235
aee4b66e 236 is( join(':', $index1->fields(qw[foo age])), 'foo:age',
14f8758f 237 'Index accepts fields');
238 is( $index1->is_valid, 1, 'Index name is now valid' );
239
240 is( $index1->type, NORMAL, 'Index type is "normal"' );
241
aee4b66e 242 my $index2 = SQL::Translator::Schema::Index->new( name => "bar" )
07680493 243 or warn SQL::Translator::Schema::Index->error;
244 $index2 = $person_table->add_index( $index2 );
245 isa_ok( $index2, 'SQL::Translator::Schema::Index', 'Index' );
246 is( $index2->name, 'bar', 'Index name is "bar"' );
247
248 my $indices = $person_table->get_indices;
249 is( scalar @$indices, 2, 'Two indices' );
250 is( $indices->[0]->name, 'foo', '"foo" index' );
251 is( $indices->[1]->name, 'bar', '"bar" index' );
252
253 #
650f87eb 254 # $table-> drop_index
255 #
256 my $dropped_index = $person_table->drop_index($index1->name);
257 isa_ok($dropped_index, 'SQL::Translator::Schema::Index', 'Dropped index "foo"' );
258 $person_table->add_index($index1);
259 my $dropped_index2 = $person_table->drop_index($index1);
260 isa_ok($dropped_index2, 'SQL::Translator::Schema::Index', 'Dropped index "foo" by object' );
261 is($dropped_index2->name, $index1->name, 'Dropped correct index "foo"');
262 my $dropped_index3 = $person_table->drop_index($index1->name);
263 like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant index "foo"] );
264
265 $person_table->add_index($index1);
266
267 #
07680493 268 # Constraint
269 #
270 my @constraints = $person_table->get_constraints;
271 is( scalar @constraints, 0, 'No constraints' );
aee4b66e 272 like( $person_table->error, qr/no constraints/i,
07680493 273 'Error for no constraints' );
aee4b66e 274 my $constraint1 = $person_table->add_constraint( name => 'foo' )
07680493 275 or warn $person_table->error;
276 isa_ok( $constraint1, 'SQL::Translator::Schema::Constraint', 'Constraint' );
277 is( $constraint1->name, 'foo', 'Constraint name is "foo"' );
278
481b05ff 279 $fields = join(',', $constraint1->fields('age') );
280 is( $fields, 'age', 'Constraint field = "age"' );
07680493 281
e21fb9dd 282 $fields = $constraint1->fields;
283 ok( ref $fields[0] && $fields[0]->isa("SQL::Translator::Schema::Field"),
284 'Constraint fields returns a SQL::Translator::Schema::Field' );
285
481b05ff 286 $fields = join(',', $constraint1->fields('age,age') );
287 is( $fields, 'age', 'Constraint field = "age"' );
07680493 288
481b05ff 289 $fields = join(',', $constraint1->fields('age', 'name') );
290 is( $fields, 'age,name', 'Constraint field = "age,name"' );
07680493 291
481b05ff 292 $fields = join(',', $constraint1->fields( 'age,name,age' ) );
293 is( $fields, 'age,name', 'Constraint field = "age,name"' );
07680493 294
481b05ff 295 $fields = join(',', $constraint1->fields( 'age, name' ) );
296 is( $fields, 'age,name', 'Constraint field = "age,name"' );
07680493 297
481b05ff 298 $fields = join(',', $constraint1->fields( [ 'age', 'name' ] ) );
299 is( $fields, 'age,name', 'Constraint field = "age,name"' );
07680493 300
481b05ff 301 $fields = join(',', $constraint1->fields( qw[ age name ] ) );
302 is( $fields, 'age,name', 'Constraint field = "age,name"' );
07680493 303
e21fb9dd 304 $fields = join(',', $constraint1->field_names );
305 is( $fields, 'age,name', 'Constraint field_names = "age,name"' );
306
14f8758f 307 is( $constraint1->match_type, '', 'Constraint match type is empty' );
aee4b66e 308 is( $constraint1->match_type('foo'), undef,
14f8758f 309 'Constraint match type rejects bad arg...' );
310 like( $constraint1->error, qr/invalid match type/i,
311 '...because it is invalid');
aee4b66e 312 is( $constraint1->match_type('FULL'), 'full',
14f8758f 313 'Constraint match type = "full"' );
314
07680493 315 my $constraint2 = SQL::Translator::Schema::Constraint->new( name => 'bar' );
316 $constraint2 = $person_table->add_constraint( $constraint2 );
317 isa_ok( $constraint2, 'SQL::Translator::Schema::Constraint', 'Constraint' );
318 is( $constraint2->name, 'bar', 'Constraint name is "bar"' );
319
637782f9 320 my $constraint3 = $person_table->add_constraint(
321 type => 'check',
322 expression => 'foo bar',
323 ) or die $person_table->error;
324 isa_ok( $constraint3, 'SQL::Translator::Schema::Constraint', 'Constraint' );
325 is( $constraint3->type, CHECK_C, 'Constraint type is "CHECK"' );
aee4b66e 326 is( $constraint3->expression, 'foo bar',
637782f9 327 'Constraint expression is "foo bar"' );
328
07680493 329 my $constraints = $person_table->get_constraints;
637782f9 330 is( scalar @$constraints, 3, 'Three constraints' );
07680493 331 is( $constraints->[0]->name, 'foo', '"foo" constraint' );
332 is( $constraints->[1]->name, 'bar', '"bar" constraint' );
333
334 #
650f87eb 335 # $table-> drop_constraint
336 #
337 my $dropped_con = $person_table->drop_constraint($constraint1->name);
338 isa_ok($dropped_con, 'SQL::Translator::Schema::Constraint', 'Dropped constraint "foo"' );
339 $person_table->add_constraint($constraint1);
340 my $dropped_con2 = $person_table->drop_constraint($constraint1);
341 isa_ok($dropped_con2, 'SQL::Translator::Schema::Constraint', 'Dropped constraint "foo" by object' );
342 is($dropped_con2->name, $constraint1->name, 'Dropped correct constraint "foo"');
343 my $dropped_con3 = $person_table->drop_constraint($constraint1->name);
344 like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant constraint "foo"] );
345
346 $person_table->add_constraint($constraint1);
347
348 #
07680493 349 # View
350 #
351 my $view = $schema->add_view( name => 'view1' ) or warn $schema->error;
352 isa_ok( $view, 'SQL::Translator::Schema::View', 'View' );
353 my $view_sql = 'select * from table';
354 is( $view->sql( $view_sql ), $view_sql, 'View SQL is good' );
355
356 my $view2 = SQL::Translator::Schema::View->new(name => 'view2') or
357 warn SQL::Translator::Schema::View->error;
358 my $check_view = $schema->add_view( $view2 );
359 is( $check_view->name, 'view2', 'Add view "view2"' );
360
361 my $redundant_view = $schema->add_view(name => 'view2');
362 is( $redundant_view, undef, qq[Didn't create another "view2" view...] );
363 like( $schema->error, qr/can't create view/i, '... because it exists' );
364
365 #
650f87eb 366 # $schema-> drop_view
367 #
368 my $dropped_view = $schema->drop_view($view->name);
369 isa_ok($dropped_view, 'SQL::Translator::Schema::View', 'Dropped view "view1"' );
370 $schema->add_view($view);
371 my $dropped_view2 = $schema->drop_view($view);
372 isa_ok($dropped_view2, 'SQL::Translator::Schema::View', 'Dropped view "view1" by object' );
373 is($dropped_view2->name, $view->name, 'Dropped correct view "view1"');
374 my $dropped_view3 = $schema->drop_view($view->name);
375 like( $schema->error, qr/doesn't exist/, qq[Can't drop non-existant view "view1"] );
376
377 $schema->add_view($view);
378
379 #
07680493 380 # $schema->get_*
381 #
382 my $bad_table = $schema->get_table;
383 like( $schema->error, qr/no table/i, 'Error on no arg to get_table' );
384
385 $bad_table = $schema->get_table('baz');
aee4b66e 386 like( $schema->error, qr/does not exist/i,
07680493 387 'Error on bad arg to get_table' );
388
389 my $bad_view = $schema->get_view;
390 like( $schema->error, qr/no view/i, 'Error on no arg to get_view' );
391
392 $bad_view = $schema->get_view('bar');
aee4b66e 393 like( $schema->error, qr/does not exist/i,
07680493 394 'Error on bad arg to get_view' );
395
396 my $good_table = $schema->get_table('foo');
397 isa_ok( $good_table, 'SQL::Translator::Schema::Table', 'Table "foo"' );
398
399 my $good_view = $schema->get_view('view1');
400 isa_ok( $good_view, 'SQL::Translator::Schema::View', 'View "view1"' );
401 is( $view->sql( $view_sql ), $view_sql, 'View SQL is good' );
402
403 #
404 # $schema->get_*s
405 #
406 my @tables = $schema->get_tables;
407 is( scalar @tables, 3, 'Found 2 tables' );
408
409 my @views = $schema->get_views;
410 is( scalar @views, 2, 'Found 1 view' );
10f36920 411
412}
413
414#
07680493 415# Test ability to introspect some values
4d878d2f 416#
aee4b66e 417{
418 my $s = SQL::Translator::Schema->new(
07680493 419 name => 'foo',
420 database => 'PostgreSQL',
421 );
0c879b5d 422 my $t = $s->add_table( name => 'person' ) or warn $s->error;
07680493 423 my $f = $t->add_field( name => 'person_id' ) or warn $t->error;
424 $f->data_type('serial');
425
426 my $c = $t->add_constraint(
427 type => PRIMARY_KEY,
428 fields => 'person_id',
429 ) or warn $t->error;
430
431 is( $f->is_primary_key, 1, 'Field is PK' );
432 is( $f->is_auto_increment, 1, 'Field is auto inc' );
433}
4d878d2f 434
435#
07680493 436# FK constraint validity
4d878d2f 437#
07680493 438{
439 my $s = SQL::Translator::Schema->new;
440 my $t = $s->add_table( name => 'person' ) or warn $s->error;
441 my $c = $t->add_constraint or warn $t->error;
442
443 is( $c->is_valid, undef, 'Constraint on "person" not valid...');
444 like( $c->error, qr/no type/i, '...because it has no type' );
445
446 is( $c->type( FOREIGN_KEY ), FOREIGN_KEY, 'Constraint type now a FK' );
447
448 is( $c->is_valid, undef, 'Constraint on "person" not valid...');
449 like( $c->error, qr/no fields/i, '...because it has no fields' );
450
451 is( join('', $c->fields('foo')), 'foo', 'Fields now = "foo"' );
452
453 is( $c->is_valid, undef, 'Constraint on "person" not valid...');
aee4b66e 454 like( $c->error, qr/non-existent field/i,
07680493 455 q[...because field "foo" doesn't exist] );
456
457 my $fk = $t->add_field( name => 'pet_id' );
458 is( $fk->name, 'pet_id', 'Added field "pet_id"' );
459 is( join('', $c->fields('pet_id')), 'pet_id', 'Fields now = "pet_id"' );
460
461 $t->add_field( name => 'f1' );
462 $t->add_field( name => 'f2' );
463 is( join(',', $c->fields('f1,f2')), 'f1,f2', 'Fields now = "f1,f2"' );
464 is( $c->is_valid, undef, 'Constraint on "person" not valid...');
aee4b66e 465 like( $c->error, qr/only one field/i,
07680493 466 q[...because too many fields for FK] );
467
468 $c->fields('f1');
469
470 is( $c->is_valid, undef, 'Constraint on "person" not valid...');
aee4b66e 471 like( $c->error, qr/no reference table/i,
07680493 472 q[...because there's no reference table] );
473
474 is( $c->reference_table('foo'), 'foo', 'Reference table now = "foo"' );
475 is( $c->is_valid, undef, 'Constraint on "person" not valid...');
aee4b66e 476 like( $c->error, qr/no table named/i,
07680493 477 q[...because reference table "foo" doesn't exist] );
478
479 my $t2 = $s->add_table( name => 'pet' );
480 is( $t2->name, 'pet', 'Added "pet" table' );
481
482 is( $c->reference_table('pet'), 'pet', 'Reference table now = "pet"' );
483
484 is( $c->is_valid, undef, 'Constraint on "person" not valid...');
485 like( $c->error, qr/no reference fields/i,
486 q[...because there're no reference fields]);
487
aee4b66e 488 is( join('', $c->reference_fields('pet_id')), 'pet_id',
07680493 489 'Reference fields = "pet_id"' );
490
491 is( $c->is_valid, undef, 'Constraint on "person" not valid...');
492 like( $c->error, qr/non-existent field/i,
493 q[...because there's no "pet_id" field in "pet"]);
494
495 my $pet_id = $t2->add_field( name => 'pet_id' );
496 is( $pet_id->name, 'pet_id', 'Added field "pet_id"' );
aee4b66e 497
07680493 498 is( $c->is_valid, 1, 'Constraint now valid' );
07680493 499}
586fba3f 500
501#
07680493 502# $table->primary_key test
586fba3f 503#
07680493 504{
505 my $s = SQL::Translator::Schema->new;
506 my $t = $s->add_table( name => 'person' );
507
508 is( $t->primary_key, undef, 'No primary key' );
586fba3f 509
aee4b66e 510 is( $t->primary_key('person_id'), undef,
07680493 511 q[Can't make PK on "person_id"...] );
512 like( $t->error, qr/invalid field/i, "...because it doesn't exist" );
586fba3f 513
07680493 514 $t->add_field( name => 'person_id' );
515 my $c = $t->primary_key('person_id');
586fba3f 516
07680493 517 isa_ok( $c, 'SQL::Translator::Schema::Constraint', 'Constraint' );
586fba3f 518
07680493 519 is( join('', $c->fields), 'person_id', 'Constraint now on "person_id"' );
586fba3f 520
07680493 521 $t->add_field( name => 'name' );
522 $c = $t->primary_key('name');
aee4b66e 523 is( join(',', $c->fields), 'person_id,name',
07680493 524 'Constraint now on "person_id" and "name"' );
525
526 is( scalar @{ $t->get_constraints }, 1, 'Found 1 constraint' );
527}
586fba3f 528
529#
07680493 530# FK finds PK
586fba3f 531#
07680493 532{
533 my $s = SQL::Translator::Schema->new;
534 my $t1 = $s->add_table( name => 'person' );
535 my $t2 = $s->add_table( name => 'pet' );
536 $t1->add_field( name => 'id' );
537 my $c1 = $t1->primary_key( 'id' ) or warn $t1->error;
538 is( $c1->type, PRIMARY_KEY, 'Made "person_id" PK on "person"' );
539
540 $t2->add_field( name => 'person_id' );
541 my $c2 = $t2->add_constraint(
542 type => PRIMARY_KEY,
543 fields => 'person_id',
544 reference_table => 'person',
545 );
586fba3f 546
07680493 547 is( join('', $c2->reference_fields), 'id', 'FK found PK "person.id"' );
548}
14f8758f 549
550#
551# View
552#
553{
22d567ca 554 my $s = SQL::Translator::Schema->new( name => 'ViewTest' );
14f8758f 555 my $name = 'foo_view';
556 my $sql = 'select name, age from person';
557 my $fields = 'name, age';
14f8758f 558 my $v = $s->add_view(
559 name => $name,
560 sql => $sql,
561 fields => $fields,
22d567ca 562 schema => $s,
14f8758f 563 );
564
565 isa_ok( $v, 'SQL::Translator::Schema::View', 'View' );
22d567ca 566 isa_ok( $v->schema, 'SQL::Translator::Schema', 'Schema' );
567 is( $v->schema->name, 'ViewTest', qq[Schema name is "'ViewTest'"] );
14f8758f 568 is( $v->name, $name, qq[Name is "$name"] );
569 is( $v->sql, $sql, qq[Name is "$sql"] );
570 is( join(':', $v->fields), 'name:age', qq[Fields are "$fields"] );
22d567ca 571
572 my @views = $s->get_views;
573 is( scalar @views, 1, 'Number of views is 1' );
574
575 my $v1 = $s->get_view( $name );
576 isa_ok( $v1, 'SQL::Translator::Schema::View', 'View' );
577 is( $v1->name, $name, qq[Name is "$name"] );
14f8758f 578}
90fd4bf5 579
580#
581# Trigger
582#
583{
22d567ca 584 my $s = SQL::Translator::Schema->new(name => 'TrigTest');
8ce5d615 585 $s->add_table(name=>'foo') or die "Couldn't create table: ", $s->error;
90fd4bf5 586 my $name = 'foo_trigger';
587 my $perform_action_when = 'after';
6c7e5b5d 588 my $database_events = 'insert';
90fd4bf5 589 my $on_table = 'foo';
590 my $action = 'update modified=timestamp();';
90fd4bf5 591 my $t = $s->add_trigger(
592 name => $name,
593 perform_action_when => $perform_action_when,
6c7e5b5d 594 database_events => $database_events,
90fd4bf5 595 on_table => $on_table,
596 action => $action,
597 ) or die $s->error;
598
599 isa_ok( $t, 'SQL::Translator::Schema::Trigger', 'Trigger' );
22d567ca 600 isa_ok( $t->schema, 'SQL::Translator::Schema', 'Schema' );
601 is( $t->schema->name, 'TrigTest', qq[Schema name is "'TrigTest'"] );
90fd4bf5 602 is( $t->name, $name, qq[Name is "$name"] );
aee4b66e 603 is( $t->perform_action_when, $perform_action_when,
90fd4bf5 604 qq[Perform action when is "$perform_action_when"] );
aee4b66e 605 is( join(',', $t->database_events), $database_events,
6c7e5b5d 606 qq[Database event is "$database_events"] );
8ce5d615 607 isa_ok( $t->table, 'SQL::Translator::Schema::Table', qq[table is a Table"] );
90fd4bf5 608 is( $t->action, $action, qq[Action is "$action"] );
22d567ca 609
610 my @triggs = $s->get_triggers;
611 is( scalar @triggs, 1, 'Number of triggers is 1' );
612
613 my $t1 = $s->get_trigger( $name );
614 isa_ok( $t1, 'SQL::Translator::Schema::Trigger', 'Trigger' );
615 is( $t1->name, $name, qq[Name is "$name"] );
22d567ca 616
8742e408 617
618
aee4b66e 619 my $s2 = SQL::Translator::Schema->new(name => 'TrigTest2');
8742e408 620 $s2->add_table(name=>'foo') or die "Couldn't create table: ", $s2->error;
621 my $t2 = $s2->add_trigger(
622 name => 'foo_trigger',
623 perform_action_when => 'after',
624 database_events => [qw/insert update/],
625 on_table => 'foo',
626 action => 'update modified=timestamp();',
627 ) or die $s2->error;
aee4b66e 628 isa_ok( $t2, 'SQL::Translator::Schema::Trigger', 'Trigger' );
8742e408 629 isa_ok( $t2->schema, 'SQL::Translator::Schema', 'Schema' );
630 is( $t2->schema->name, 'TrigTest2', qq[Schema name is "'TrigTest2'"] );
631 is( $t2->name, 'foo_trigger', qq[Name is "foo_trigger"] );
aee4b66e 632 is_deeply(
6c7e5b5d 633 [$t2->database_events],
634 [qw/insert update/],
635 "Database events are [qw/insert update/] "
636 );
aee4b66e 637 isa_ok($t2->database_events,'ARRAY','Database events');
638
639 #
640 # Trigger equal tests
641 #
642 isnt(
6c7e5b5d 643 $t1->equals($t2),
644 1,
645 'Compare two Triggers with database_event and database_events'
646 );
647
aee4b66e 648 $t1->database_events($database_events);
649 $t2->database_events($database_events);
650 is($t1->equals($t2),1,'Compare two Triggers with database_event');
651
652 $t2->database_events('');
653 $t1->database_events([qw/update insert/]);
654 $t2->database_events([qw/insert update/]);
655 is($t1->equals($t2),1,'Compare two Triggers with database_events');
8742e408 656
650f87eb 657 #
658 # $schema-> drop_trigger
659 #
660 my $dropped_trig = $s->drop_trigger($t->name);
661 isa_ok($dropped_trig, 'SQL::Translator::Schema::Trigger', 'Dropped trigger "foo_trigger"' );
662 $s->add_trigger($t);
663 my $dropped_trig2 = $s->drop_trigger($t);
664 isa_ok($dropped_trig2, 'SQL::Translator::Schema::Trigger', 'Dropped trigger "foo_trigger" by object' );
665 is($dropped_trig2->name, $t->name, 'Dropped correct trigger "foo_trigger"');
666 my $dropped_trig3 = $s->drop_trigger($t->name);
667 like( $s->error, qr/doesn't exist/, qq[Can't drop non-existant trigger "foo_trigger"] );
668
669 $s->add_trigger($t);
670}
aee4b66e 671
22d567ca 672#
673# Procedure
674#
675{
676 my $s = SQL::Translator::Schema->new( name => 'ProcTest' );
677 my $name = 'foo_proc';
678 my $sql = 'select foo from bar';
679 my $parameters = 'foo, bar';
680 my $owner = 'Nomar';
681 my $comments = 'Go Sox!';
682 my $p = $s->add_procedure(
683 name => $name,
684 sql => $sql,
685 parameters => $parameters,
686 owner => $owner,
687 comments => $comments,
688 ) or die $s->error;
689
690 isa_ok( $p, 'SQL::Translator::Schema::Procedure', 'Procedure' );
691 isa_ok( $p->schema, 'SQL::Translator::Schema', 'Schema' );
692 is( $p->schema->name, 'ProcTest', qq[Schema name is "'ProcTest'"] );
693 is( $p->name, $name, qq[Name is "$name"] );
694 is( $p->sql, $sql, qq[SQL is "$sql"] );
695 is( join(',', $p->parameters), 'foo,bar', qq[Params = 'foo,bar'] );
696 is( $p->comments, $comments, qq[Comments = "$comments"] );
697
698 my @procs = $s->get_procedures;
699 is( scalar @procs, 1, 'Number of procedures is 1' );
700
701 my $p1 = $s->get_procedure( $name );
702 isa_ok( $p1, 'SQL::Translator::Schema::Procedure', 'Procedure' );
703 is( $p1->name, $name, qq[Name is "$name"] );
650f87eb 704
705 #
706 # $schema-> drop_procedure
707 #
708 my $dropped_proc = $s->drop_procedure($p->name);
709 isa_ok($dropped_proc, 'SQL::Translator::Schema::Procedure', 'Dropped procedure "foo_proc"' );
710 $s->add_procedure($p);
711 my $dropped_proc2 = $s->drop_procedure($p);
712 isa_ok($dropped_proc2, 'SQL::Translator::Schema::Procedure', 'Dropped procedure "foo_proc" by object' );
713 is($dropped_proc2->name, $p->name, 'Dropped correct procedure "foo_proc"');
714 my $dropped_proc3 = $s->drop_procedure($p->name);
715 like( $s->error, qr/doesn't exist/, qq[Can't drop non-existant procedure "foo_proc"] );
716
717 $s->add_procedure($p);
90fd4bf5 718}
807290c3 719
720#
721# Test field order
722#
723{
724 my $s = SQL::Translator::Schema->new;
725 my $t = $s->add_table( name => 'person' );
726 my $f3 = $t->add_field( name => 'age', order => 3 );
727 my $f1 = $t->add_field( name => 'person_id', order => 1 );
728 my $f2 = $t->add_field( name => 'name', order => 2 );
729 my $f4 = $t->add_field( name => 'gender' );
730 my $f5 = $t->add_field( name => 'alias' );
731
732 is( $f1->order, 1, 'Field order is passed, order is 1' );
733 is( $f2->order, 2, 'Field order is passed, order is 2' );
734 is( $f3->order, 3, 'Field order is passed, order is 3' );
735 is( $f4->order, 4, 'Field order is not passed, order is 4' );
736 is( $f5->order, 5, 'Field order is not passed, order is 5' );
737
738 my $t2 = $s->add_table( name => 'place' );
739 $f2 = $t2->add_field( name => 'name', order => 2 );
740
741 throws_ok { my $f22 = $t2->add_field( name => 'name2', order => 2 ) }
742 qr/\QRequested order '2' for column 'name2' conflicts with already existing column 'name'/;
743
744 throws_ok { $f1 = $t2->add_field( name => 'location' ) }
745 qr/field order incomplete/;
746}
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)