Commit | Line | Data |
1223c9b2 |
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 | # |
8 | # basic.t |
9 | # ------- |
10 | # Tests that; |
11 | # |
12 | |
13 | use strict; |
14 | use Test::More; |
15 | use Test::Exception; |
16 | |
17 | use strict; |
18 | use Data::Dumper; |
19 | my %opt; |
20 | BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } |
21 | use constant DEBUG => (exists $opt{d} ? 1 : 0); |
22 | local $SIG{__WARN__} = sub { diag "[warn] ", @_; }; |
23 | |
24 | use FindBin qw/$Bin/; |
25 | |
26 | # Usefull test subs for the schema objs |
27 | #============================================================================= |
28 | |
29 | my %ATTRIBUTES; |
30 | $ATTRIBUTES{field} = [qw/ |
31 | name |
32 | data_type |
33 | default_value |
34 | size |
35 | is_primary_key |
36 | is_unique |
37 | is_nullable |
38 | is_foreign_key |
39 | is_auto_increment |
40 | /]; |
41 | |
42 | sub test_field { |
43 | my ($fld,$test) = @_; |
44 | die "test_field needs a least a name!" unless $test->{name}; |
45 | my $name = $test->{name}; |
46 | |
47 | foreach my $attr ( @{$ATTRIBUTES{field}} ) { |
48 | if ( exists $test->{$attr} ) { |
49 | my $ans = $test->{$attr}; |
50 | if ( $attr =~ m/^is_/ ) { |
51 | if ($ans) { ok $fld->$attr, " $name - $attr true"; } |
52 | else { ok !$fld->$attr, " $name - $attr false"; } |
53 | } |
54 | else { |
55 | is $fld->$attr, $ans, " $name - $attr = '" |
56 | .(defined $ans ? $ans : "NULL" )."'"; |
57 | } |
58 | } |
59 | else { |
60 | ok !$fld->$attr, "$name - $attr not set"; |
61 | } |
62 | } |
63 | } |
64 | |
65 | sub test_table { |
66 | my $tbl = shift; |
67 | my %arg = @_; |
68 | my $name = $arg{name} || die "Need a table name to test."; |
69 | my @fldnames = map { $_->{name} } @{$arg{fields}}; |
70 | is_deeply( [ map {$_->name} $tbl->get_fields ], |
71 | [ map {$_->{name}} @{$arg{fields}} ], |
72 | "Table $name\'s fields" ); |
73 | foreach ( @{$arg{fields}} ) { |
74 | my $name = $_->{name} || die "Need a field name to test."; |
75 | test_field( $tbl->get_field($name), $_ ); |
76 | } |
77 | } |
78 | |
79 | # Testing 1,2,3,.. |
80 | #============================================================================= |
81 | |
ef2d7798 |
82 | plan tests => 111; |
1223c9b2 |
83 | |
84 | use SQL::Translator; |
85 | use SQL::Translator::Schema::Constants; |
86 | |
87 | my $testschema = "$Bin/data/xmi/Foo.poseidon2.xmi"; |
ef2d7798 |
88 | die "Can't find test schema $testschema" unless -e $testschema; |
89 | my %base_translator_args = ( |
90 | filename => $testschema, |
91 | from => 'XML-XMI', |
92 | to => 'MySQL', |
1223c9b2 |
93 | debug => DEBUG, |
94 | show_warnings => 1, |
95 | add_drop_table => 1, |
96 | ); |
ef2d7798 |
97 | |
98 | # |
99 | # Basic tests |
100 | # |
101 | { |
102 | |
103 | my $obj; |
104 | $obj = SQL::Translator->new( |
105 | filename => $testschema, |
1223c9b2 |
106 | from => 'XML-XMI', |
107 | to => 'MySQL', |
ef2d7798 |
108 | debug => DEBUG, |
109 | show_warnings => 1, |
110 | add_drop_table => 1, |
1223c9b2 |
111 | ); |
ef2d7798 |
112 | my $sql = $obj->translate; |
1223c9b2 |
113 | print $sql if DEBUG; |
114 | #print "Debug: translator", Dumper($obj) if DEBUG; |
115 | #print "Debug: schema", Dumper($obj->schema) if DEBUG; |
116 | |
117 | # |
ef2d7798 |
118 | # Test the schema |
1223c9b2 |
119 | # |
120 | my $scma = $obj->schema; |
121 | my @tblnames = map {$_->name} $scma->get_tables; |
ef2d7798 |
122 | is_deeply( \@tblnames, [qw/Foo PrivateFoo Recording Track ProtectedFoo/] |
123 | ,"tables"); |
124 | |
125 | # |
126 | |
127 | # |
128 | # Tables |
1223c9b2 |
129 | # |
130 | # Foo |
131 | # |
132 | test_table( $scma->get_table("Foo"), |
133 | name => "Foo", |
134 | fields => [ |
ef2d7798 |
135 | { |
136 | name => "fooid", |
137 | data_type => "int", |
138 | default_value => undef, |
139 | is_nullable => 1, |
140 | is_primary_key => 1, |
141 | }, |
142 | { |
143 | name => "name", |
144 | data_type => "varchar", |
145 | default_value => "", |
146 | is_nullable => 1, |
147 | }, |
148 | { |
149 | name => "protectedname", |
150 | data_type => "varchar", |
151 | default_value => undef, |
152 | is_nullable => 1, |
153 | }, |
154 | { |
155 | name => "privatename", |
156 | data_type => "varchar", |
157 | default_value => undef, |
158 | is_nullable => 1, |
159 | }, |
160 | ], |
1223c9b2 |
161 | ); |
162 | |
163 | # |
164 | # Recording |
165 | # |
166 | test_table( $scma->get_table("Recording"), |
167 | name => "Recording", |
168 | fields => [ |
169 | { |
170 | name => "recordingid", |
171 | data_type => "int", |
172 | default_value => undef, |
173 | is_nullable => 1, |
174 | is_primary_key => 1, |
175 | }, |
176 | { |
177 | name => "title", |
178 | data_type => "varchar", |
179 | is_nullable => 1, |
180 | }, |
181 | { |
182 | name => "type", |
183 | data_type => "varchar", |
184 | is_nullable => 1, |
185 | }, |
186 | ], |
187 | ); |
188 | |
189 | # |
190 | # Track |
191 | # |
192 | test_table( $scma->get_table("Track"), |
193 | name => "Track", |
194 | fields => [ |
195 | { |
196 | name => "trackid", |
197 | data_type => "int", |
198 | default_value => undef, |
199 | is_nullable => 1, |
200 | is_primary_key => 1, |
201 | }, |
202 | { |
203 | name => "recordingid", |
204 | data_type => "int", |
205 | default_value => undef, |
206 | is_nullable => 1, |
207 | is_primary_key => 0, |
208 | #is_foreign_key => 1, |
209 | }, |
210 | { |
211 | name => "number", |
212 | data_type => "int", |
213 | default_value => "1", |
214 | is_nullable => 1, |
215 | }, |
216 | { |
217 | name => "name", |
218 | data_type => "varchar", |
219 | is_nullable => 1, |
220 | }, |
221 | ], |
222 | ); |
ef2d7798 |
223 | |
224 | } # end basic tests |
225 | |
226 | # |
227 | # Visibility tests |
228 | # |
229 | { |
230 | |
231 | # Classes |
232 | my @testd = ( |
233 | "" => [qw/Foo PrivateFoo Recording Track ProtectedFoo/], |
234 | [qw/fooid name protectedname privatename/], |
235 | "public" => [qw/Foo Recording Track/], |
236 | [qw/fooid name /], |
237 | "protected" => [qw/Foo Recording Track ProtectedFoo/], |
238 | [qw/fooid name protectedname/], |
239 | "private" => [qw/Foo PrivateFoo Recording Track ProtectedFoo/], |
240 | [qw/fooid name protectedname privatename/], |
241 | ); |
242 | while ( my ($vis,$tables,$foofields) = splice @testd,0,3 ) { |
243 | my $obj; |
244 | $obj = SQL::Translator->new( |
245 | filename => $testschema, |
246 | from => 'XML-XMI', |
247 | to => 'MySQL', |
248 | debug => DEBUG, |
249 | show_warnings => 1, |
250 | add_drop_table => 1, |
251 | parser_args => { |
252 | visibility => $vis, |
253 | }, |
254 | ); |
255 | my $sql = $obj->translate; |
256 | my $scma = $obj->schema; |
257 | |
258 | my @tblnames = map {$_->name} $scma->get_tables; |
259 | is_deeply( \@tblnames, $tables, "Tables with visibility => '$vis'"); |
260 | |
261 | my @fldnames = map {$_->name} $scma->get_table("Foo")->get_fields; |
262 | is_deeply( \@fldnames, $foofields, "Foo fields with visibility => '$vis'"); |
263 | |
264 | #print "Debug: translator", Dumper($obj) if DEBUG; |
265 | #print "Debug: schema", Dumper($obj->schema) if DEBUG; |
266 | } |
267 | |
268 | # # Classes |
269 | # %testd = ( |
270 | # "" => [qw/fooid name protectedname privatename/], |
271 | # "public" => [qw/fooid name /], |
272 | # "protected" => [qw/fooid name protectedname/], |
273 | # "private" => [qw/fooid name protectedname privatename/], |
274 | # ); |
275 | # while ( my ($vis,$ans) = each %testd ) { |
276 | # my $obj; |
277 | # $obj = SQL::Translator->new( |
278 | # filename => $testschema, |
279 | # from => 'XML-XMI', |
280 | # to => 'MySQL', |
281 | # debug => DEBUG, |
282 | # show_warnings => 1, |
283 | # add_drop_table => 1, |
284 | # parser_args => { |
285 | # visibility => $vis, |
286 | # }, |
287 | # ); |
288 | # my $sql = $obj->translate; |
289 | # my $scma = $obj->schema; |
290 | # my @names = map {$_->name} $scma->get_table("Foo")->get_fields; |
291 | # is_deeply( \@names, $ans, "Foo fields with visibility => '$vis'"); |
292 | # |
293 | # #print "Debug: translator", Dumper($obj) if DEBUG; |
294 | # #print "Debug: schema", Dumper($obj->schema) if DEBUG; |
295 | # } |
296 | # |
297 | } # end visibility tests |