Commit | Line | Data |
c76749e1 |
1 | #!/usr/bin/perl -w |
2 | # vim:filetype=perl |
3 | |
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' |
6 | |
7 | use strict; |
8 | use FindBin qw/$Bin/; |
9 | use Data::Dumper; |
10 | |
11 | # run with -d for debug |
12 | my %opt; |
13 | BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } |
14 | use constant DEBUG => (exists $opt{d} ? 1 : 0); |
15 | |
16 | use Test::More; |
17 | use Test::Exception; |
18 | use SQL::Translator; |
19 | use SQL::Translator::Schema::Constants; |
20 | |
21 | # Usefull test subs for the schema objs |
22 | #============================================================================= |
23 | |
24 | sub test_field { |
25 | my ($f1,$test) = @_; |
26 | |
27 | is( $f1->name, $test->{name}, " Field name '$test->{name}'" ); |
28 | |
29 | is( $f1->data_type, $test->{data_type}, " Type is '$test->{data_type}'" ) |
30 | if exists $test->{data_type}; |
31 | |
32 | is( $f1->size, $test->{size}, " Size is '$test->{size}'" ) |
33 | if exists $test->{size}; |
34 | |
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}; |
38 | |
39 | is( $f1->is_nullable, $test->{is_nullable}, |
40 | " ".($test->{is_nullable} ? 'can' : 'cannot').' be null' ) |
41 | if exists $test->{is_nullable}; |
42 | |
43 | is( $f1->is_unique, $test->{is_unique}, |
44 | " ".($test->{is_unique} ? 'can' : 'cannot').' be unique' ) |
45 | if exists $test->{is_unique}; |
46 | |
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}; |
50 | |
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}; |
54 | |
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}; |
58 | } |
59 | |
60 | sub constraint_ok { |
61 | my ($con,$test) = @_; |
62 | #$test->{name} ||= "<anon>"; |
63 | |
64 | if ( exists $test->{name} ) { |
65 | is( $con->name, $test->{name}, " Constraint '$test->{name}'" ); |
66 | } |
67 | else { |
68 | ok( $con, " Constraint" ); |
69 | } |
70 | |
71 | is( $con->type, $test->{type}, " type is '$test->{type}'" ) |
72 | if exists $test->{type}; |
73 | |
74 | is( $con->table->name, $test->{table}, " table is '$test->{table}'" ) |
75 | if exists $test->{table}; |
76 | |
77 | is( join(",",$con->fields), $test->{fields}, |
78 | " fields is '$test->{fields}'" ) |
79 | if exists $test->{fields}; |
80 | |
81 | is( $con->reference_table, $test->{reference_table}, |
82 | " reference_table is '$test->{reference_table}'" ) |
83 | if exists $test->{reference_table}; |
84 | |
85 | is( join(",",$con->reference_fields), $test->{reference_fields}, |
86 | " reference_fields is '$test->{reference_fields}'" ) |
87 | if exists $test->{reference_fields}; |
88 | |
89 | is( $con->match_type, $test->{match_type}, |
90 | " match_type is '$test->{match_type}'" ) |
91 | if exists $test->{match_type}; |
92 | |
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}; |
96 | |
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}; |
100 | } |
101 | |
102 | sub test_table { |
103 | my $tbl = shift; |
104 | my %arg = @_; |
105 | $arg{constraints} ||= []; |
106 | my $name = $arg{name} || die "Need a table name to test."; |
107 | |
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), $_ ); |
115 | } |
116 | |
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"); |
121 | foreach ( @cons ) { |
122 | my $ans = { table => $tbl->name, %{shift @tcons}}; |
123 | constraint_ok( $_, $ans ); |
124 | } |
125 | } |
126 | } |
127 | |
128 | # Testing 1,2,3,.. |
129 | #============================================================================= |
130 | |
131 | plan tests => 92; |
132 | |
133 | my $testschema = "$Bin/data/xmi/OrderDB.rationalprofile.poseidon2.xmi"; |
134 | die "Can't find test schema $testschema" unless -e $testschema; |
135 | |
136 | my $obj; |
137 | $obj = SQL::Translator->new( |
138 | filename => $testschema, |
139 | from => 'XML-XMI-Rational', |
140 | to => 'MySQL', |
141 | debug => DEBUG, |
142 | show_warnings => 1, |
143 | add_drop_table => 0, |
144 | ); |
145 | my $sql = $obj->translate; |
146 | print $sql if DEBUG; |
147 | |
148 | # |
149 | # Test the schema |
150 | # |
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/] |
156 | ,"tables"); |
157 | |
158 | test_table( $scma->get_table("Customer"), |
159 | name => "Customer", |
160 | fields => [ |
161 | { |
162 | name => "customerID", |
163 | data_type => "INT", |
164 | size => 10, |
165 | default_value => undef, |
166 | is_nullable => 0, |
167 | is_primary_key => 1, |
168 | }, |
169 | { |
170 | name => "name", |
171 | data_type => "VARCHAR", |
172 | size => 255, |
173 | default_value => undef, |
174 | is_nullable => 0, |
175 | is_primary_key => 0, |
176 | }, |
177 | { |
178 | name => "email", |
179 | data_type => "VARCHAR", |
180 | size => 255, |
181 | default_value => undef, |
182 | is_nullable => 1, |
183 | is_primary_key => 0, |
184 | }, |
185 | ], |
186 | constraints => [ |
187 | { |
188 | type => "PRIMARY KEY", |
189 | fields => "customerID", |
190 | }, |
191 | { |
192 | name => "UniqueEmail", |
193 | type => "UNIQUE", |
194 | fields => "email", |
195 | }, |
196 | ], |
197 | ); |
198 | |
199 | test_table( $scma->get_table("Order"), |
200 | name => "Order", |
201 | fields => [ |
202 | { |
203 | name => "orderID", |
204 | data_type => "INT", |
205 | size => 10, |
206 | default_value => undef, |
207 | is_nullable => 0, |
208 | is_primary_key => 1, |
209 | }, |
210 | { |
211 | name => "customerID", |
212 | data_type => "INT", |
213 | size => 10, |
214 | default_value => undef, |
215 | is_nullable => 0, |
216 | is_primary_key => 0, |
217 | is_foreign_key => 1, |
218 | }, |
219 | { |
220 | name => "orderDate", |
221 | data_type => "DATE", |
222 | default_value => undef, |
223 | is_nullable => 0, |
224 | is_primary_key => 0, |
225 | }, |
226 | ], |
227 | constraints => [ |
228 | { |
229 | type => "PRIMARY KEY", |
230 | fields => "orderID", |
231 | }, |
232 | { |
233 | type => "FOREIGN KEY", |
234 | fields => "customerID", |
235 | reference_table => "Customer", |
236 | reference_fields => "customerID", |
237 | }, |
238 | ], |
239 | # TODO |
240 | #indexes => [ |
241 | # { |
242 | # name => "idxOrderDate", |
243 | # type => "INDEX", |
244 | # fields => "orderDate", |
245 | # }, |
246 | #], |
247 | ); |
248 | |
249 | |
250 | test_table( $scma->get_table("OrderLine"), |
251 | name => "OrderLine", |
252 | fields => [ |
253 | { |
254 | name => "lineNumber", |
255 | data_type => "INT", |
256 | size => 10, |
257 | default_value => 1, |
258 | is_nullable => 0, |
259 | is_primary_key => 1, |
260 | }, |
261 | { |
262 | name => "orderID", |
263 | data_type => "INT", |
264 | size => 10, |
265 | default_value => undef, |
266 | is_nullable => 0, |
267 | is_primary_key => 0, |
268 | is_foreign_key => 1, |
269 | }, |
270 | { |
271 | name => "quantity", |
272 | data_type => "INT", |
273 | size => 2, |
274 | default_value => 1, |
275 | is_nullable => 0, |
276 | is_primary_key => 0, |
277 | }, |
278 | ], |
279 | constraints => [ |
280 | { |
281 | type => "PRIMARY KEY", |
282 | fields => "lineNumber,orderID", |
283 | }, |
284 | { |
285 | type => "FOREIGN KEY", |
286 | fields => "orderID", |
287 | reference_table => "Order", |
288 | reference_fields => "orderID", |
289 | }, |
290 | ], |
291 | ); |