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};
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"; }
55 is $fld->$attr, $ans, " $name - $attr = '"
56 .(defined $ans ? $ans : "NULL" )."'";
60 ok !$fld->$attr, "$name - $attr not set";
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), $_ );
80 #=============================================================================
85 use SQL::Translator::Schema::Constants;
87 my $testschema = "$Bin/data/xmi/Foo.poseidon2.xmi";
88 die "Can't find test schema $testschema" unless -e $testschema;
89 my %base_translator_args = (
90 filename => $testschema,
104 $obj = SQL::Translator->new(
105 filename => $testschema,
112 my $sql = $obj->translate;
114 #print "Debug: translator", Dumper($obj) if DEBUG;
115 #print "Debug: schema", Dumper($obj->schema) if DEBUG;
120 my $scma = $obj->schema;
121 my @tblnames = map {$_->name} $scma->get_tables;
122 is_deeply( \@tblnames, [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/]
132 test_table( $scma->get_table("Foo"),
138 default_value => undef,
144 data_type => "varchar",
149 name => "protectedname",
150 data_type => "varchar",
151 default_value => undef,
155 name => "privatename",
156 data_type => "varchar",
157 default_value => undef,
166 test_table( $scma->get_table("Recording"),
170 name => "recordingid",
172 default_value => undef,
178 data_type => "varchar",
183 data_type => "varchar",
192 test_table( $scma->get_table("Track"),
198 default_value => undef,
203 name => "recordingid",
205 default_value => undef,
208 #is_foreign_key => 1,
213 default_value => "1",
218 data_type => "varchar",
233 "" => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
234 [qw/fooid name protectedname privatename/],
235 "public" => [qw/Foo Recording CD Track/],
237 "protected" => [qw/Foo Recording CD Track ProtectedFoo/],
238 [qw/fooid name protectedname/],
239 "private" => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
240 [qw/fooid name protectedname privatename/],
242 while ( my ($vis,$tables,$foofields) = splice @testd,0,3 ) {
244 $obj = SQL::Translator->new(
245 filename => $testschema,
255 my $sql = $obj->translate;
256 my $scma = $obj->schema;
258 my @tblnames = map {$_->name} $scma->get_tables;
259 is_deeply( \@tblnames, $tables, "Tables with visibility => '$vis'");
261 my @fldnames = map {$_->name} $scma->get_table("Foo")->get_fields;
262 is_deeply( \@fldnames, $foofields, "Foo fields with visibility => '$vis'");
264 #print "Debug: translator", Dumper($obj) if DEBUG;
265 #print "Debug: schema", Dumper($obj->schema) if DEBUG;
270 # "" => [qw/fooid name protectedname privatename/],
271 # "public" => [qw/fooid name /],
272 # "protected" => [qw/fooid name protectedname/],
273 # "private" => [qw/fooid name protectedname privatename/],
275 # while ( my ($vis,$ans) = each %testd ) {
277 # $obj = SQL::Translator->new(
278 # filename => $testschema,
282 # show_warnings => 1,
283 # add_drop_table => 1,
285 # visibility => $vis,
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'");
293 # #print "Debug: translator", Dumper($obj) if DEBUG;
294 # #print "Debug: schema", Dumper($obj->schema) if DEBUG;
297 } # end visibility tests