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' |
c957e92d |
6 | # |
1c375f48 |
7 | # Run script with -d for debug. |
c957e92d |
8 | |
2e11379e |
9 | use strict; |
1c375f48 |
10 | |
11 | use FindBin qw/$Bin/; |
12 | |
b3530353 |
13 | use Test::More; |
1c375f48 |
14 | use Test::SQL::Translator; |
c957e92d |
15 | use Test::Exception; |
c957e92d |
16 | use Data::Dumper; |
1c375f48 |
17 | use SQL::Translator; |
18 | use SQL::Translator::Schema::Constants; |
19 | |
20 | # Simple options. -d for debug |
2e11379e |
21 | my %opt; |
c957e92d |
22 | BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } |
23 | use constant DEBUG => (exists $opt{d} ? 1 : 0); |
c957e92d |
24 | |
c957e92d |
25 | |
26 | # Testing 1,2,3,4... |
27 | #============================================================================= |
28 | |
1c375f48 |
29 | plan tests => 274; |
c957e92d |
30 | |
07a82527 |
31 | foreach ( |
32 | "$Bin/data/xml/schema-basic.xml", |
33 | "$Bin/data/xml/schema-basic-attribs.xml" |
34 | ) { |
35 | do_file($_); |
36 | } |
37 | |
38 | sub do_file { |
39 | my $testschema = shift; |
40 | # Parse the test XML schema |
2e11379e |
41 | my $obj; |
07a82527 |
42 | $obj = SQL::Translator->new( |
43 | debug => DEBUG, |
44 | show_warnings => 1, |
45 | add_drop_table => 1, |
46 | ); |
47 | die "Can't find test schema $testschema" unless -e $testschema; |
48 | my $sql = $obj->translate( |
2e11379e |
49 | from => 'XML-SQLFairy', |
50 | to => 'MySQL', |
07a82527 |
51 | filename => $testschema, |
52 | ); |
53 | print $sql if DEBUG; |
07a82527 |
54 | |
55 | # Test the schema objs generted from the XML |
56 | # |
57 | my $scma = $obj->schema; |
58 | my @tblnames = map {$_->name} $scma->get_tables; |
59 | is_deeply( \@tblnames, [qw/Basic/], "tables"); |
60 | |
61 | # Basic |
62 | my $tbl = $scma->get_table("Basic"); |
63 | is_deeply( [map {$_->name} $tbl->get_fields], [qw/ |
64 | id title description email explicitnulldef explicitemptystring emptytagdef |
65 | /] , "Table Basic's fields"); |
07a82527 |
66 | |
1c375f48 |
67 | table_ok( $scma->get_table("Basic"), { |
68 | name => "Basic", |
69 | fields => [ |
70 | { |
71 | name => "id", |
72 | data_type => "int", |
73 | default_value => undef, |
74 | is_nullable => 0, |
75 | size => 10, |
76 | is_primary_key => 1, |
77 | is_auto_increment => 1, |
78 | }, |
79 | { |
80 | name => "title", |
81 | data_type => "varchar", |
82 | is_nullable => 0, |
83 | default_value => "hello", |
84 | size => 100, |
85 | }, |
86 | { |
87 | name => "description", |
88 | data_type => "text", |
89 | is_nullable => 1, |
90 | default_value => "", |
91 | }, |
92 | { |
93 | name => "email", |
94 | data_type => "varchar", |
95 | size => 255, |
96 | is_unique => 1, |
97 | default_value => undef, |
98 | is_nullable => 1, |
99 | }, |
100 | { |
101 | name => "explicitnulldef", |
102 | data_type => "varchar", |
103 | default_value => undef, |
104 | is_nullable => 1, |
105 | }, |
106 | { |
107 | name => "explicitemptystring", |
108 | data_type => "varchar", |
109 | default_value => "", |
110 | is_nullable => 1, |
111 | }, |
112 | { |
113 | name => "emptytagdef", |
114 | data_type => "varchar", |
115 | default_value => "", |
116 | is_nullable => 1, |
117 | }, |
118 | ], |
119 | constraints => [ |
120 | { |
121 | type => PRIMARY_KEY, |
122 | fields => ["id"], |
123 | }, |
124 | { |
125 | name => 'emailuniqueindex', |
126 | type => UNIQUE, |
127 | fields => ["email"], |
128 | } |
129 | ], |
130 | indices => [ |
131 | { |
132 | name => "titleindex", |
133 | fields => ["title"], |
134 | }, |
135 | ], |
136 | }); |
19922fbc |
137 | |
138 | # |
139 | # View |
1c375f48 |
140 | # |
19922fbc |
141 | my @views = $scma->get_views; |
1c375f48 |
142 | view_ok( $views[0], { |
143 | name => 'email_list', |
144 | sql => "SELECT email FROM Basic WHERE email IS NOT NULL", |
145 | fields => ['email'], |
146 | }); |
147 | |
148 | my @triggs = $scma->get_triggers; |
149 | trigger_ok( $triggs[0], { |
150 | name => 'foo_trigger', |
151 | perform_action_when => 'after', |
152 | database_event => 'insert', |
153 | on_table => 'foo', |
154 | action => 'update modified=timestamp();', |
155 | }); |
156 | |
19922fbc |
157 | |
19922fbc |
158 | # |
159 | # Procedure |
160 | # |
1c375f48 |
161 | my @procs = $scma->get_procedures; |
162 | procedure_ok( $procs[0], { |
163 | name => 'foo_proc', |
164 | sql => 'select foo from bar', |
165 | parameters => ['foo', 'bar'], |
166 | owner => 'Nomar', |
167 | comments => 'Go Sox!', |
168 | }); |
19922fbc |
169 | |
1c375f48 |
170 | print "Debug:", Dumper($obj) if DEBUG; |
07a82527 |
171 | } # /Test of schema |