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'
20 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
21 use constant DEBUG => (exists $opt{d} ? 1 : 0);
22 local $SIG{__WARN__} = sub { diag "[warn] ", @_; };
26 # Usefull test subs for the schema objs
27 #=============================================================================
30 $ATTRIBUTES{field} = [qw/
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";
48 foreach my $attr ( @{$ATTRIBUTES{field}} ) {
49 if ( exists $test->{$attr} ) {
50 my $ans = $test->{$attr};
51 if ( $attr =~ m/^is_/ ) {
52 if ($ans) { ok $fld->$attr, "$name - $attr true"; }
53 else { ok !$fld->$attr, "$name - $attr false"; }
56 is $fld->$attr, $ans, "$name - $attr = '"
57 .(defined $ans ? $ans : "NULL" )."'";
61 ok !$fld->$attr, "$name - $attr not set";
66 # TODO test_constraint, test_index
69 #=============================================================================
74 use SQL::Translator::Schema::Constants;
77 "$Bin/data/xml/schema-basic.xml",
78 "$Bin/data/xml/schema-basic-attribs.xml"
84 my $testschema = shift;
85 # Parse the test XML schema
87 $obj = SQL::Translator->new(
92 die "Can't find test schema $testschema" unless -e $testschema;
93 my $sql = $obj->translate(
94 from => 'XML-SQLFairy',
96 filename => $testschema,
99 #print "Debug:", Dumper($obj) if DEBUG;
101 # Test the schema objs generted from the XML
103 my $scma = $obj->schema;
104 my @tblnames = map {$_->name} $scma->get_tables;
105 is_deeply( \@tblnames, [qw/Basic/], "tables");
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"),{
115 default_value => undef,
119 is_auto_increment => 1,
121 test_field($tbl->get_field("title"),{
123 data_type => "varchar",
125 default_value => "hello",
128 test_field($tbl->get_field("description"),{
129 name => "description",
134 test_field($tbl->get_field("email"),{
136 data_type => "varchar",
139 default_value => undef,
142 test_field($tbl->get_field("explicitnulldef"),{
143 name => "explicitnulldef",
144 data_type => "varchar",
145 default_value => undef,
148 test_field($tbl->get_field("explicitemptystring"),{
149 name => "explicitemptystring",
150 data_type => "varchar",
154 test_field($tbl->get_field("emptytagdef"),{
155 name => "emptytagdef",
156 data_type => "varchar",
161 my @indices = $tbl->get_indices;
162 is scalar(@indices), 1, "Table basic has 1 index";
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";
179 my @views = $scma->get_views;
180 is( scalar @views, 1, 'Number of views is 1' );
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",
186 is( join(",",$v->fields), 'email', "View's Fields" );
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' );
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"] );
214 my $name = 'foo_proc';
215 my $sql = 'select foo from bar';
216 my $parameters = 'foo, bar';
218 my $comments = 'Go Sox!';
219 my @procs = $scma->get_procedures;
220 is( scalar @procs, 1, 'Number of procedures is 1' );
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"] );