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'
7 # Run script with -d for debug.
14 use Test::SQL::Translator;
18 use SQL::Translator::Schema::Constants;
20 # Simple options. -d for debug
22 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
23 use constant DEBUG => (exists $opt{d} ? 1 : 0);
27 #=============================================================================
32 "$Bin/data/xml/schema-basic.xml",
33 "$Bin/data/xml/schema-basic-attribs.xml"
39 my $testschema = shift;
40 # Parse the test XML schema
42 $obj = SQL::Translator->new(
47 die "Can't find test schema $testschema" unless -e $testschema;
48 my $sql = $obj->translate(
49 from => 'XML-SQLFairy',
51 filename => $testschema,
55 # Test the schema objs generted from the XML
57 my $scma = $obj->schema;
58 my @tblnames = map {$_->name} $scma->get_tables;
59 is_deeply( \@tblnames, [qw/Basic/], "tables");
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");
67 table_ok( $scma->get_table("Basic"), {
73 default_value => undef,
77 is_auto_increment => 1,
81 data_type => "varchar",
83 default_value => "hello",
87 name => "description",
94 data_type => "varchar",
97 default_value => undef,
101 name => "explicitnulldef",
102 data_type => "varchar",
103 default_value => undef,
107 name => "explicitemptystring",
108 data_type => "varchar",
113 name => "emptytagdef",
114 data_type => "varchar",
125 name => 'emailuniqueindex',
132 name => "titleindex",
141 my @views = $scma->get_views;
142 view_ok( $views[0], {
143 name => 'email_list',
144 sql => "SELECT email FROM Basic WHERE email IS NOT NULL",
148 my @triggs = $scma->get_triggers;
149 trigger_ok( $triggs[0], {
150 name => 'foo_trigger',
151 perform_action_when => 'after',
152 database_event => 'insert',
154 action => 'update modified=timestamp();',
161 my @procs = $scma->get_procedures;
162 procedure_ok( $procs[0], {
164 sql => 'select foo from bar',
165 parameters => ['foo', 'bar'],
167 comments => 'Go Sox!',
170 print "Debug:", Dumper($obj) if DEBUG;