t/13schema.t

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