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 => 85;
  83
  84 use SQL::Translator;
  85 use SQL::Translator::Schema::Constants;
  86
  87 my $testschema = "$Bin/data/xmi/Foo.poseidon2.xmi";
  88 # Parse the test XML schema
  89 my $obj;
  90 $obj = SQL::Translator->new(
  91     debug          => DEBUG,
  92     show_warnings  => 1,
  93     add_drop_table => 1,
  94 );
  95 die "Can't find test schema $testschema" unless -e $testschema;
  96 my $sql = $obj->translate(
  97     from     => 'XML-XMI',
  98     to       => 'MySQL',
  99     filename => $testschema,
 100 );
 101 print $sql if DEBUG;
 102 #print "Debug: translator", Dumper($obj) if DEBUG;
 103 #print "Debug: schema", Dumper($obj->schema) if DEBUG;
 104
 105 #
 106 # Test the schema objs generted from the XML
 107 #
 108 my $scma = $obj->schema;
 109 my @tblnames = map {$_->name} $scma->get_tables;
 110 is_deeply( \@tblnames, [qw/Foo PrivateFoo Recording Track/], "tables");
 111
 112 #
 113 # Foo
 114 #
 115 test_table( $scma->get_table("Foo"),
 116     name => "Foo",
 117     fields => [
 118     {
 119         name => "fooid",
 120         data_type => "int",
 121         default_value => undef,
 122         is_nullable => 1,
 123         is_primary_key => 1,
 124     },
 125     {
 126         name => "name",
 127         data_type => "varchar",
 128         default_value => "",
 129         is_nullable => 1,
 130     } ],
 131 );
 132
 133 #
 134 # Recording
 135 #
 136 test_table( $scma->get_table("Recording"),
 137     name => "Recording",
 138     fields => [
 139     {
 140         name => "recordingid",
 141         data_type => "int",
 142         default_value => undef,
 143         is_nullable => 1,
 144         is_primary_key => 1,
 145     },
 146     {
 147         name => "title",
 148         data_type => "varchar",
 149         is_nullable => 1,
 150     },
 151     {
 152         name => "type",
 153         data_type => "varchar",
 154         is_nullable => 1,
 155     },
 156     ],
 157 );
 158
 159 #
 160 # Track
 161 #
 162 test_table( $scma->get_table("Track"),
 163     name => "Track",
 164     fields => [
 165     {
 166         name => "trackid",
 167         data_type => "int",
 168         default_value => undef,
 169         is_nullable => 1,
 170         is_primary_key => 1,
 171     },
 172     {
 173         name => "recordingid",
 174         data_type => "int",
 175         default_value => undef,
 176         is_nullable => 1,
 177         is_primary_key => 0,
 178         #is_foreign_key => 1,
 179     },
 180     {
 181         name => "number",
 182         data_type => "int",
 183         default_value => "1",
 184         is_nullable => 1,
 185     },
 186     {
 187         name => "name",
 188         data_type => "varchar",
 189         is_nullable => 1,
 190     },
 191     ],
 192 );