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