t/23xml-xmi-parser-rational.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 use strict;
   8 use FindBin qw/$Bin/;
   9 use Data::Dumper;
  10
  11 # run with -d for debug
  12 my %opt;
  13 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
  14 use constant DEBUG => (exists $opt{d} ? 1 : 0);
  15
  16 use Test::More;
  17 use Test::Exception;
  18 use Test::SQL::Translator qw(maybe_plan);
  19 use SQL::Translator;
  20 use SQL::Translator::Schema::Constants;
  21
  22 BEGIN {
  23     maybe_plan(92,
  24         'SQL::Translator::Parser::XML::XMI::Rational',
  25         'SQL::Translator::Producer::MySQL');
  26 }
  27
  28 # Usefull test subs for the schema objs
  29 #=============================================================================
  30
  31 sub test_field {
  32     my ($f1,$test) = @_;
  33
  34         is( $f1->name, $test->{name}, "  Field name '$test->{name}'" );
  35
  36         is( $f1->data_type, $test->{data_type}, "    Type is '$test->{data_type}'" )
  37         if exists $test->{data_type};
  38
  39         is( $f1->size, $test->{size}, "    Size is '$test->{size}'" )
  40         if exists $test->{size};
  41
  42         is( $f1->default_value, $test->{default_value},
  43         "    Default value is ".(defined($test->{default_value}) ? "'$test->{default_value}'" : "UNDEF" ) )
  44         if exists $test->{default_value};
  45
  46         is( $f1->is_nullable, $test->{is_nullable},
  47                 "    ".($test->{is_nullable} ? 'can' : 'cannot').' be null' )
  48         if exists $test->{is_nullable};
  49
  50         is( $f1->is_unique, $test->{is_unique},
  51                 "    ".($test->{is_unique} ? 'can' : 'cannot').' be unique' )
  52         if exists $test->{is_unique};
  53
  54         is( $f1->is_primary_key, $test->{is_primary_key},
  55                 "    is ".($test->{is_primary_key} ? '' : 'not').' a primary_key' )
  56         if exists $test->{is_primary_key};
  57
  58         is( $f1->is_foreign_key, $test->{is_foreign_key},
  59                 "    is ".($test->{is_foreign_key} ? '' : 'not').' a foreign_key' )
  60         if exists $test->{is_foreign_key};
  61
  62         is( $f1->is_auto_increment, $test->{is_auto_increment},
  63         "    is ".($test->{is_auto_increment} ?  '' : 'not').' an auto_increment' )
  64         if exists $test->{is_auto_increment};
  65 }
  66
  67 sub constraint_ok {
  68     my ($con,$test) = @_;
  69         #$test->{name} ||= "<anon>";
  70
  71         if ( exists $test->{name} ) {
  72                 is( $con->name, $test->{name}, "  Constraint '$test->{name}'" );
  73         }
  74         else {
  75                 ok( $con, "  Constraint" );
  76         }
  77
  78         is( $con->type, $test->{type}, "    type is '$test->{type}'" )
  79         if exists $test->{type};
  80
  81         is( $con->table->name, $test->{table}, "    table is '$test->{table}'" )
  82         if exists $test->{table};
  83
  84         is( join(",",$con->fields), $test->{fields},
  85         "    fields is '$test->{fields}'" )
  86         if exists $test->{fields};
  87
  88         is( $con->reference_table, $test->{reference_table},
  89         "    reference_table is '$test->{reference_table}'" )
  90         if exists $test->{reference_table};
  91
  92         is( join(",",$con->reference_fields), $test->{reference_fields},
  93         "    reference_fields is '$test->{reference_fields}'" )
  94         if exists $test->{reference_fields};
  95
  96         is( $con->match_type, $test->{match_type},
  97         "    match_type is '$test->{match_type}'" )
  98         if exists $test->{match_type};
  99
 100         is( $con->on_delete, $test->{on_delete},
 101         "    on_delete is '$test->{on_delete}'" )
 102         if exists $test->{on_delete};
 103
 104         is( $con->on_update, $test->{on_update},
 105         "    on_update is '$test->{on_update}'" )
 106         if exists $test->{on_update};
 107 }
 108
 109 sub test_table {
 110     my $tbl = shift;
 111     my %arg = @_;
 112         $arg{constraints} ||= [];
 113     my $name = $arg{name} || die "Need a table name to test.";
 114
 115         my @fldnames = map { $_->{name} } @{$arg{fields}};
 116         is_deeply( [ map {$_->name}   $tbl->get_fields ],
 117                [ map {$_->{name}} @{$arg{fields}} ],
 118                "Table $name\'s fields" );
 119     foreach ( @{$arg{fields}} ) {
 120         my $name = $_->{name} || die "Need a field name to test.";
 121         test_field( $tbl->get_field($name), $_ );
 122     }
 123
 124         if ( my @tcons = @{$arg{constraints}} ) {
 125                 my @cons = $tbl->get_constraints;
 126                 is(scalar(@cons), scalar(@tcons),
 127                 "Table $name has ".scalar(@tcons)." Constraints");
 128                 foreach ( @cons ) {
 129                         my $ans = { table => $tbl->name, %{shift @tcons}};
 130                         constraint_ok( $_, $ans  );
 131                 }
 132         }
 133 }
 134
 135 # Testing 1,2,3,..
 136 #=============================================================================
 137
 138 my $testschema = "$Bin/data/xmi/OrderDB.rationalprofile.poseidon2.xmi";
 139 die "Can't find test schema $testschema" unless -e $testschema;
 140
 141 my $obj;
 142 $obj = SQL::Translator->new(
 143     filename => $testschema,
 144     from     => 'XML-XMI-Rational',
 145     to       => 'MySQL',
 146     debug          => DEBUG,
 147     show_warnings  => 1,
 148     add_drop_table => 0,
 149 );
 150 my $sql = $obj->translate;
 151 print $sql if DEBUG;
 152
 153 #
 154 # Test the schema
 155 #
 156 my $scma = $obj->schema;
 157 is( $scma->is_valid, 1, 'Schema is valid' );
 158 my @tblnames = map {$_->name} $scma->get_tables;
 159 is(scalar(@{$scma->get_tables}), scalar(@tblnames), "Right number of tables");
 160 is_deeply( \@tblnames, [qw/Order OrderLine Customer/]
 161     ,"tables");
 162
 163 test_table( $scma->get_table("Customer"),
 164     name => "Customer",
 165     fields => [
 166     {
 167         name => "customerID",
 168         data_type => "INT",
 169                 size => 10,
 170         default_value => undef,
 171         is_nullable => 0,
 172         is_primary_key => 1,
 173     },
 174     {
 175         name => "name",
 176         data_type => "VARCHAR",
 177                 size => 255,
 178         default_value => undef,
 179         is_nullable => 0,
 180         is_primary_key => 0,
 181     },
 182     {
 183         name => "email",
 184         data_type => "VARCHAR",
 185                 size => 255,
 186         default_value => undef,
 187         is_nullable => 1,
 188         is_primary_key => 0,
 189     },
 190     ],
 191         constraints => [
 192                 {
 193                         type => "PRIMARY KEY",
 194                         fields => "customerID",
 195                 },
 196                 {
 197                         name => "UniqueEmail",
 198                         type => "UNIQUE",
 199                         fields => "email",
 200                 },
 201         ],
 202 );
 203
 204 test_table( $scma->get_table("Order"),
 205     name => "Order",
 206     fields => [
 207     {
 208         name => "orderID",
 209         data_type => "INT",
 210                 size => 10,
 211         default_value => undef,
 212         is_nullable => 0,
 213         is_primary_key => 1,
 214     },
 215     {
 216         name => "customerID",
 217         data_type => "INT",
 218                 size => 10,
 219         default_value => undef,
 220         is_nullable => 0,
 221         is_primary_key => 0,
 222         is_foreign_key => 1,
 223     },
 224     {
 225         name => "orderDate",
 226         data_type => "DATE",
 227         default_value => undef,
 228         is_nullable => 0,
 229         is_primary_key => 0,
 230     },
 231     ],
 232         constraints => [
 233                 {
 234                         type => "PRIMARY KEY",
 235                         fields => "orderID",
 236                 },
 237                 {
 238                         type => "FOREIGN KEY",
 239                         fields => "customerID",
 240                         reference_table => "Customer",
 241                         reference_fields => "customerID",
 242                 },
 243         ],
 244         # TODO
 245         #indexes => [
 246         #       {
 247         #               name => "idxOrderDate",
 248         #               type => "INDEX",
 249         #               fields => "orderDate",
 250         #       },
 251         #],
 252 );
 253
 254
 255 test_table( $scma->get_table("OrderLine"),
 256     name => "OrderLine",
 257     fields => [
 258     {
 259         name => "lineNumber",
 260         data_type => "INT",
 261                 size => 10,
 262         default_value => 1,
 263         is_nullable => 0,
 264         is_primary_key => 1,
 265     },
 266     {
 267         name => "orderID",
 268         data_type => "INT",
 269                 size => 10,
 270         default_value => undef,
 271         is_nullable => 0,
 272         is_primary_key => 0,
 273         is_foreign_key => 1,
 274     },
 275     {
 276         name => "quantity",
 277         data_type => "INT",
 278                 size => 2,
 279         default_value => 1,
 280         is_nullable => 0,
 281         is_primary_key => 0,
 282     },
 283     ],
 284         constraints => [
 285                 {
 286                         type => "PRIMARY KEY",
 287                         fields => "lineNumber,orderID",
 288                 },
 289                 {
 290                         type => "FOREIGN KEY",
 291                         fields => "orderID",
 292                         reference_table => "Order",
 293                         reference_fields => "orderID",
 294                 },
 295         ],
 296 );