t/21xml-xmi-parser.t

   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
  13 use strict;
  14 use Test::More;
  15 use Test::Exception;
  16
  17 use strict;
  18 use Data::Dumper;
  19 my %opt;
  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
  29 my %ATTRIBUTES;
  30 $ATTRIBUTES{field} = [qw/
  31 name
  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 {
  43     my ($fld,$test) = @_;
  44     die "test_field needs a least a name!" unless $test->{name};
  45     my $name = $test->{name};
  46
  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"; }
  53             }
  54             else {
  55                 is $fld->$attr, $ans, " $name - $attr = '"
  56                                      .(defined $ans ? $ans : "NULL" )."'";
  57             }
  58         }
  59         else {
  60             ok !$fld->$attr, "$name - $attr not set";
  61         }
  62     }
  63 }
  64
  65 sub test_table {
  66     my $tbl = shift;
  67     my %arg = @_;
  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), $_ );
  76     }
  77 }
  78
  79 # Testing 1,2,3,..
  80 #=============================================================================
  81
  82 plan tests => 111;
  83
  84 use SQL::Translator;
  85 use SQL::Translator::Schema::Constants;
  86
  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,
  91     from     => 'XML-XMI',
  92     to       => 'MySQL',
  93     debug          => DEBUG,
  94     show_warnings  => 1,
  95     add_drop_table => 1,
  96 );
  97
  98 #
  99 # Basic tests
 100 #
 101 {
 102
 103 my $obj;
 104 $obj = SQL::Translator->new(
 105     filename => $testschema,
 106     from     => 'XML-XMI',
 107     to       => 'MySQL',
 108     debug          => DEBUG,
 109     show_warnings  => 1,
 110     add_drop_table => 1,
 111 );
 112 my $sql = $obj->translate;
 113 print $sql if DEBUG;
 114 #print "Debug: translator", Dumper($obj) if DEBUG;
 115 #print "Debug: schema", Dumper($obj->schema) if DEBUG;
 116
 117 #
 118 # Test the schema
 119 #
 120 my $scma = $obj->schema;
 121 my @tblnames = map {$_->name} $scma->get_tables;
 122 is_deeply( \@tblnames, [qw/Foo PrivateFoo Recording Track ProtectedFoo/]
 123     ,"tables");
 124
 125 #
 126
 127 #
 128 # Tables
 129 #
 130 # Foo
 131 #
 132 test_table( $scma->get_table("Foo"),
 133     name => "Foo",
 134     fields => [
 135         {
 136             name => "fooid",
 137             data_type => "int",
 138             default_value => undef,
 139             is_nullable => 1,
 140             is_primary_key => 1,
 141         },
 142         {
 143             name => "name",
 144             data_type => "varchar",
 145             default_value => "",
 146             is_nullable => 1,
 147         },
 148         {
 149             name => "protectedname",
 150             data_type => "varchar",
 151             default_value => undef,
 152             is_nullable => 1,
 153         },
 154         {
 155             name => "privatename",
 156             data_type => "varchar",
 157             default_value => undef,
 158             is_nullable => 1,
 159         },
 160     ],
 161 );
 162
 163 #
 164 # Recording
 165 #
 166 test_table( $scma->get_table("Recording"),
 167     name => "Recording",
 168     fields => [
 169     {
 170         name => "recordingid",
 171         data_type => "int",
 172         default_value => undef,
 173         is_nullable => 1,
 174         is_primary_key => 1,
 175     },
 176     {
 177         name => "title",
 178         data_type => "varchar",
 179         is_nullable => 1,
 180     },
 181     {
 182         name => "type",
 183         data_type => "varchar",
 184         is_nullable => 1,
 185     },
 186     ],
 187 );
 188
 189 #
 190 # Track
 191 #
 192 test_table( $scma->get_table("Track"),
 193     name => "Track",
 194     fields => [
 195     {
 196         name => "trackid",
 197         data_type => "int",
 198         default_value => undef,
 199         is_nullable => 1,
 200         is_primary_key => 1,
 201     },
 202     {
 203         name => "recordingid",
 204         data_type => "int",
 205         default_value => undef,
 206         is_nullable => 1,
 207         is_primary_key => 0,
 208         #is_foreign_key => 1,
 209     },
 210     {
 211         name => "number",
 212         data_type => "int",
 213         default_value => "1",
 214         is_nullable => 1,
 215     },
 216     {
 217         name => "name",
 218         data_type => "varchar",
 219         is_nullable => 1,
 220     },
 221     ],
 222 );
 223
 224 } # end basic tests
 225
 226 #
 227 # Visibility tests
 228 #
 229 {
 230
 231 # Classes
 232 my @testd = (
 233     ""          => [qw/Foo PrivateFoo Recording Track ProtectedFoo/],
 234                    [qw/fooid name protectedname privatename/],
 235     "public"    => [qw/Foo Recording Track/],
 236                    [qw/fooid name /],
 237     "protected" => [qw/Foo Recording Track ProtectedFoo/],
 238                    [qw/fooid name protectedname/],
 239     "private"   => [qw/Foo PrivateFoo Recording Track ProtectedFoo/],
 240                    [qw/fooid name protectedname privatename/],
 241 );
 242     while ( my ($vis,$tables,$foofields) = splice @testd,0,3 ) {
 243     my $obj;
 244     $obj = SQL::Translator->new(
 245         filename => $testschema,
 246         from     => 'XML-XMI',
 247         to       => 'MySQL',
 248         debug          => DEBUG,
 249         show_warnings  => 1,
 250         add_drop_table => 1,
 251         parser_args => {
 252             visibility => $vis,
 253         },
 254     );
 255     my $sql = $obj->translate;
 256     my $scma = $obj->schema;
 257
 258     my @tblnames = map {$_->name} $scma->get_tables;
 259     is_deeply( \@tblnames, $tables, "Tables with visibility => '$vis'");
 260
 261     my @fldnames = map {$_->name} $scma->get_table("Foo")->get_fields;
 262     is_deeply( \@fldnames, $foofields, "Foo fields with visibility => '$vis'");
 263
 264     #print "Debug: translator", Dumper($obj) if DEBUG;
 265     #print "Debug: schema", Dumper($obj->schema) if DEBUG;
 266 }
 267
 268 # # Classes
 269 # %testd = (
 270 #     ""          => [qw/fooid name protectedname privatename/],
 271 #     "public"    => [qw/fooid name /],
 272 #     "protected" => [qw/fooid name protectedname/],
 273 #     "private"   => [qw/fooid name protectedname privatename/],
 274 # );
 275 #     while ( my ($vis,$ans) = each %testd ) {
 276 #     my $obj;
 277 #     $obj = SQL::Translator->new(
 278 #         filename => $testschema,
 279 #         from     => 'XML-XMI',
 280 #         to       => 'MySQL',
 281 #         debug          => DEBUG,
 282 #         show_warnings  => 1,
 283 #         add_drop_table => 1,
 284 #         parser_args => {
 285 #             visibility => $vis,
 286 #         },
 287 #     );
 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'");
 292 #
 293 #     #print "Debug: translator", Dumper($obj) if DEBUG;
 294 #     #print "Debug: schema", Dumper($obj->schema) if DEBUG;
 295 # }
 296 #
 297 } # end visibility tests