4 # Before `make install' is performed this script should be runnable with
5 # `make test'. After `make install' it should work as `perl test.pl'
11 # run with -d for debug
13 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
14 use constant DEBUG => (exists $opt{d} ? 1 : 0);
19 use SQL::Translator::Schema::Constants;
21 # Usefull test subs for the schema objs
22 #=============================================================================
27 is( $f1->name, $test->{name}, " Field name '$test->{name}'" );
29 is( $f1->data_type, $test->{data_type}, " Type is '$test->{data_type}'" )
30 if exists $test->{data_type};
32 is( $f1->size, $test->{size}, " Size is '$test->{size}'" )
33 if exists $test->{size};
35 is( $f1->default_value, $test->{default_value},
36 " Default value is ".(defined($test->{default_value}) ? "'$test->{default_value}'" : "UNDEF" ) )
37 if exists $test->{default_value};
39 is( $f1->is_nullable, $test->{is_nullable},
40 " ".($test->{is_nullable} ? 'can' : 'cannot').' be null' )
41 if exists $test->{is_nullable};
43 is( $f1->is_unique, $test->{is_unique},
44 " ".($test->{is_unique} ? 'can' : 'cannot').' be unique' )
45 if exists $test->{is_unique};
47 is( $f1->is_primary_key, $test->{is_primary_key},
48 " is ".($test->{is_primary_key} ? '' : 'not').' a primary_key' )
49 if exists $test->{is_primary_key};
51 is( $f1->is_foreign_key, $test->{is_foreign_key},
52 " is ".($test->{is_foreign_key} ? '' : 'not').' a foreign_key' )
53 if exists $test->{is_foreign_key};
55 is( $f1->is_auto_increment, $test->{is_auto_increment},
56 " is ".($test->{is_auto_increment} ? '' : 'not').' an auto_increment' )
57 if exists $test->{is_auto_increment};
62 #$test->{name} ||= "<anon>";
64 if ( exists $test->{name} ) {
65 is( $con->name, $test->{name}, " Constraint '$test->{name}'" );
68 ok( $con, " Constraint" );
71 is( $con->type, $test->{type}, " type is '$test->{type}'" )
72 if exists $test->{type};
74 is( $con->table->name, $test->{table}, " table is '$test->{table}'" )
75 if exists $test->{table};
77 is( join(",",$con->fields), $test->{fields},
78 " fields is '$test->{fields}'" )
79 if exists $test->{fields};
81 is( $con->reference_table, $test->{reference_table},
82 " reference_table is '$test->{reference_table}'" )
83 if exists $test->{reference_table};
85 is( join(",",$con->reference_fields), $test->{reference_fields},
86 " reference_fields is '$test->{reference_fields}'" )
87 if exists $test->{reference_fields};
89 is( $con->match_type, $test->{match_type},
90 " match_type is '$test->{match_type}'" )
91 if exists $test->{match_type};
93 is( $con->on_delete_do, $test->{on_delete_do},
94 " on_delete_do is '$test->{on_delete_do}'" )
95 if exists $test->{on_delete_do};
97 is( $con->on_update_do, $test->{on_update_do},
98 " on_update_do is '$test->{on_update_do}'" )
99 if exists $test->{on_update_do};
105 $arg{constraints} ||= [];
106 my $name = $arg{name} || die "Need a table name to test.";
108 my @fldnames = map { $_->{name} } @{$arg{fields}};
109 is_deeply( [ map {$_->name} $tbl->get_fields ],
110 [ map {$_->{name}} @{$arg{fields}} ],
111 "Table $name\'s fields" );
112 foreach ( @{$arg{fields}} ) {
113 my $name = $_->{name} || die "Need a field name to test.";
114 test_field( $tbl->get_field($name), $_ );
117 if ( my @tcons = @{$arg{constraints}} ) {
118 my @cons = $tbl->get_constraints;
119 is(scalar(@cons), scalar(@tcons),
120 "Table $name has ".scalar(@tcons)." Constraints");
122 my $ans = { table => $tbl->name, %{shift @tcons}};
123 constraint_ok( $_, $ans );
129 #=============================================================================
133 my $testschema = "$Bin/data/xmi/OrderDB.rationalprofile.poseidon2.xmi";
134 die "Can't find test schema $testschema" unless -e $testschema;
137 $obj = SQL::Translator->new(
138 filename => $testschema,
139 from => 'XML-XMI-Rational',
145 my $sql = $obj->translate;
151 my $scma = $obj->schema;
152 is( $scma->is_valid, 1, 'Schema is valid' );
153 my @tblnames = map {$_->name} $scma->get_tables;
154 is(scalar(@{$scma->get_tables}), scalar(@tblnames), "Right number of tables");
155 is_deeply( \@tblnames, [qw/Order OrderLine Customer/]
158 test_table( $scma->get_table("Customer"),
162 name => "customerID",
165 default_value => undef,
171 data_type => "VARCHAR",
173 default_value => undef,
179 data_type => "VARCHAR",
181 default_value => undef,
188 type => "PRIMARY KEY",
189 fields => "customerID",
192 name => "UniqueEmail",
199 test_table( $scma->get_table("Order"),
206 default_value => undef,
211 name => "customerID",
214 default_value => undef,
222 default_value => undef,
229 type => "PRIMARY KEY",
233 type => "FOREIGN KEY",
234 fields => "customerID",
235 reference_table => "Customer",
236 reference_fields => "customerID",
242 # name => "idxOrderDate",
244 # fields => "orderDate",
250 test_table( $scma->get_table("OrderLine"),
254 name => "lineNumber",
265 default_value => undef,
281 type => "PRIMARY KEY",
282 fields => "lineNumber,orderID",
285 type => "FOREIGN KEY",
287 reference_table => "Order",
288 reference_fields => "orderID",