Commit | Line | Data |
c957e92d |
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 | |
2e11379e |
13 | use strict; |
b3530353 |
14 | use Test::More; |
c957e92d |
15 | use Test::Exception; |
16 | |
17 | use strict; |
18 | use Data::Dumper; |
2e11379e |
19 | my %opt; |
c957e92d |
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 | |
2e11379e |
29 | my %ATTRIBUTES; |
c957e92d |
30 | $ATTRIBUTES{field} = [qw/ |
31 | name |
c957e92d |
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 { |
5ff70f1a |
43 | my ($fld,$test) = @_; |
44 | die "test_field needs a least a name!" unless $test->{name}; |
45 | my $name = $test->{name}; |
46 | is $fld->name, $name, "$name - Name right"; |
47 | |
48 | foreach my $attr ( @{$ATTRIBUTES{field}} ) { |
49 | if ( exists $test->{$attr} ) { |
50 | my $ans = $test->{$attr}; |
51 | if ( $attr =~ m/^is_/ ) { |
19922fbc |
52 | if ($ans) { ok $fld->$attr, "$name - $attr true"; } |
53 | else { ok !$fld->$attr, "$name - $attr false"; } |
5ff70f1a |
54 | } |
55 | else { |
19922fbc |
56 | is $fld->$attr, $ans, "$name - $attr = '" |
5ff70f1a |
57 | .(defined $ans ? $ans : "NULL" )."'"; |
58 | } |
59 | } |
60 | else { |
61 | ok !$fld->$attr, "$name - $attr not set"; |
62 | } |
63 | } |
c957e92d |
64 | } |
65 | |
66 | # TODO test_constraint, test_index |
67 | |
68 | # Testing 1,2,3,4... |
69 | #============================================================================= |
70 | |
19922fbc |
71 | plan tests => 198; |
b3530353 |
72 | |
c957e92d |
73 | use SQL::Translator; |
74 | use SQL::Translator::Schema::Constants; |
75 | |
07a82527 |
76 | foreach ( |
77 | "$Bin/data/xml/schema-basic.xml", |
78 | "$Bin/data/xml/schema-basic-attribs.xml" |
79 | ) { |
80 | do_file($_); |
81 | } |
82 | |
83 | sub do_file { |
84 | my $testschema = shift; |
85 | # Parse the test XML schema |
2e11379e |
86 | my $obj; |
07a82527 |
87 | $obj = SQL::Translator->new( |
88 | debug => DEBUG, |
89 | show_warnings => 1, |
90 | add_drop_table => 1, |
91 | ); |
92 | die "Can't find test schema $testschema" unless -e $testschema; |
93 | my $sql = $obj->translate( |
2e11379e |
94 | from => 'XML-SQLFairy', |
95 | to => 'MySQL', |
07a82527 |
96 | filename => $testschema, |
97 | ); |
98 | print $sql if DEBUG; |
99 | #print "Debug:", Dumper($obj) if DEBUG; |
100 | |
101 | # Test the schema objs generted from the XML |
102 | # |
103 | my $scma = $obj->schema; |
104 | my @tblnames = map {$_->name} $scma->get_tables; |
105 | is_deeply( \@tblnames, [qw/Basic/], "tables"); |
106 | |
107 | # Basic |
108 | my $tbl = $scma->get_table("Basic"); |
109 | is_deeply( [map {$_->name} $tbl->get_fields], [qw/ |
110 | id title description email explicitnulldef explicitemptystring emptytagdef |
111 | /] , "Table Basic's fields"); |
112 | test_field($tbl->get_field("id"),{ |
113 | name => "id", |
114 | data_type => "int", |
115 | default_value => undef, |
116 | is_nullable => 0, |
117 | size => 10, |
118 | is_primary_key => 1, |
119 | is_auto_increment => 1, |
120 | }); |
121 | test_field($tbl->get_field("title"),{ |
122 | name => "title", |
123 | data_type => "varchar", |
124 | is_nullable => 0, |
125 | default_value => "hello", |
126 | size => 100, |
127 | }); |
128 | test_field($tbl->get_field("description"),{ |
129 | name => "description", |
130 | data_type => "text", |
131 | is_nullable => 1, |
132 | default_value => "", |
133 | }); |
134 | test_field($tbl->get_field("email"),{ |
135 | name => "email", |
136 | data_type => "varchar", |
137 | size => 255, |
138 | is_unique => 1, |
139 | default_value => undef, |
140 | is_nullable => 1, |
141 | }); |
142 | test_field($tbl->get_field("explicitnulldef"),{ |
143 | name => "explicitnulldef", |
144 | data_type => "varchar", |
145 | default_value => undef, |
146 | is_nullable => 1, |
147 | }); |
148 | test_field($tbl->get_field("explicitemptystring"),{ |
149 | name => "explicitemptystring", |
150 | data_type => "varchar", |
151 | default_value => "", |
152 | is_nullable => 1, |
153 | }); |
154 | test_field($tbl->get_field("emptytagdef"),{ |
155 | name => "emptytagdef", |
156 | data_type => "varchar", |
157 | default_value => "", |
158 | is_nullable => 1, |
159 | }); |
160 | |
161 | my @indices = $tbl->get_indices; |
162 | is scalar(@indices), 1, "Table basic has 1 index"; |
163 | |
164 | my @constraints = $tbl->get_constraints; |
165 | is scalar(@constraints), 2, "Table basic has 2 constraints"; |
166 | my $con = shift @constraints; |
167 | is $con->table, $tbl, "Constaints table right"; |
168 | is $con->name, "", "Constaints table right"; |
169 | is $con->type, PRIMARY_KEY, "Constaint is primary key"; |
170 | is_deeply [$con->fields], ["id"], "Constaint fields"; |
171 | $con = shift @constraints; |
172 | is $con->table, $tbl, "Constaints table right"; |
173 | is $con->type, UNIQUE, "Constaint UNIQUE"; |
174 | is_deeply [$con->fields], ["email"], "Constaint fields"; |
19922fbc |
175 | |
176 | # |
177 | # View |
178 | # |
179 | my @views = $scma->get_views; |
180 | is( scalar @views, 1, 'Number of views is 1' ); |
181 | my $v = $views[0]; |
182 | isa_ok( $v, 'SQL::Translator::Schema::View', 'View' ); |
183 | is( $v->name, 'email_list', "View's Name is 'email_list'" ); |
184 | is( $v->sql, "SELECT email FROM Basic WHERE email IS NOT NULL", |
185 | "View's sql" ); |
186 | is( join(",",$v->fields), 'email', "View's Fields" ); |
187 | |
188 | # |
189 | # Trigger |
190 | # |
191 | { |
192 | my $name = 'foo_trigger'; |
193 | my $perform_action_when = 'after'; |
194 | my $database_event = 'insert'; |
195 | my $on_table = 'foo'; |
196 | my $action = 'update modified=timestamp();'; |
197 | my @triggs = $scma->get_triggers; |
198 | is( scalar @triggs, 1, 'Number of triggers is 1' ); |
199 | my $t = $triggs[0]; |
200 | isa_ok( $t, 'SQL::Translator::Schema::Trigger', 'Trigger' ); |
201 | is( $t->name, $name, qq[Name is "$name"] ); |
202 | is( $t->perform_action_when, $perform_action_when, |
203 | qq[Perform action when is "$perform_action_when"] ); |
204 | is( $t->database_event, $database_event, |
205 | qq[Database event is "$database_event"] ); |
206 | is( $t->on_table, $on_table, qq[Table is "$on_table"] ); |
207 | is( $t->action, $action, qq[Action is "$action"] ); |
208 | } |
209 | |
210 | # |
211 | # Procedure |
212 | # |
213 | { |
214 | my $name = 'foo_proc'; |
215 | my $sql = 'select foo from bar'; |
216 | my $parameters = 'foo, bar'; |
217 | my $owner = 'Nomar'; |
218 | my $comments = 'Go Sox!'; |
219 | my @procs = $scma->get_procedures; |
220 | is( scalar @procs, 1, 'Number of procedures is 1' ); |
221 | my $p = $procs[0]; |
222 | isa_ok( $p, 'SQL::Translator::Schema::Procedure', 'Procedure' ); |
223 | is( $p->name, $name, qq[Name is "$name"] ); |
224 | is( $p->sql, $sql, qq[SQL is "$sql"] ); |
225 | is( join(',', $p->parameters), 'foo,bar', qq[Params = 'foo,bar'] ); |
226 | is( $p->comments, $comments, qq[Comments = "$comments"] ); |
227 | } |
228 | |
07a82527 |
229 | } # /Test of schema |