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
  23 use FindBin qw/$Bin/;
  24
  25 # Usefull test subs for the schema objs
  26 #=============================================================================
  27
  28 my %ATTRIBUTES;
  29 $ATTRIBUTES{field} = [qw/
  30 name
  31 data_type
  32 default_value
  33 size
  34 is_primary_key
  35 is_unique
  36 is_nullable
  37 is_foreign_key
  38 is_auto_increment
  39 /];
  40
  41 sub test_field {
  42     my ($fld,$test) = @_;
  43     die "test_field needs a least a name!" unless $test->{name};
  44     my $name = $test->{name};
  45
  46     foreach my $attr ( @{$ATTRIBUTES{field}} ) {
  47         if ( exists $test->{$attr} ) {
  48             my $ans = $test->{$attr};
  49             if ( $attr =~ m/^is_/ ) {
  50                 if ($ans) { ok $fld->$attr,  " $name - $attr true"; }
  51                 else      { ok !$fld->$attr, " $name - $attr false"; }
  52             }
  53             else {
  54                 is $fld->$attr, $ans, " $name - $attr = '"
  55                                      .(defined $ans ? $ans : "NULL" )."'";
  56             }
  57         }
  58         else {
  59             ok !$fld->$attr, "$name - $attr not set";
  60         }
  61     }
  62 }
  63
  64 sub test_table {
  65     my $tbl = shift;
  66     my %arg = @_;
  67     my $name = $arg{name} || die "Need a table name to test.";
  68     my @fldnames = map { $_->{name} } @{$arg{fields}};
  69     is_deeply( [ map {$_->name}   $tbl->get_fields ],
  70                [ map {$_->{name}} @{$arg{fields}} ],
  71                "Table $name\'s fields" );
  72     foreach ( @{$arg{fields}} ) {
  73         my $name = $_->{name} || die "Need a field name to test.";
  74         test_field( $tbl->get_field($name), $_ );
  75     }
  76 }
  77
  78 # Testing 1,2,3,..
  79 #=============================================================================
  80
  81 plan tests => 103;
  82
  83 use SQL::Translator;
  84 use SQL::Translator::Schema::Constants;
  85
  86 my $testschema = "$Bin/data/xmi/Foo.poseidon2.xmi";
  87 die "Can't find test schema $testschema" unless -e $testschema;
  88 my %base_translator_args = (
  89     filename => $testschema,
  90     from     => 'XML-XMI',
  91     to       => 'MySQL',
  92     debug          => DEBUG,
  93     show_warnings  => 1,
  94     add_drop_table => 1,
  95 );
  96
  97 #
  98 # Basic tests
  99 #
 100 my $obj;
 101 $obj = SQL::Translator->new(
 102     filename => $testschema,
 103     from     => 'XML-XMI',
 104     to       => 'MySQL',
 105     debug          => DEBUG,
 106     show_warnings  => 1,
 107     add_drop_table => 1,
 108 );
 109 my $sql = $obj->translate;
 110 print $sql if DEBUG;
 111 #print "Debug: translator", Dumper($obj) if DEBUG;
 112 #print "Debug: schema", Dumper($obj->schema) if DEBUG;
 113
 114 #
 115 # Test the schema
 116 #
 117 my $scma = $obj->schema;
 118 my @tblnames = map {$_->name} $scma->get_tables;
 119 is_deeply( \@tblnames, [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/]
 120     ,"tables");
 121
 122 #
 123
 124 #
 125 # Tables
 126 #
 127 # Foo
 128 #
 129 test_table( $scma->get_table("Foo"),
 130     name => "Foo",
 131     fields => [
 132         {
 133             name => "fooid",
 134             data_type => "int",
 135             default_value => undef,
 136             is_nullable => 1,
 137             is_primary_key => 1,
 138         },
 139         {
 140             name => "name",
 141             data_type => "varchar",
 142             default_value => "",
 143             is_nullable => 1,
 144         },
 145         {
 146             name => "protectedname",
 147             data_type => "varchar",
 148             default_value => undef,
 149             is_nullable => 1,
 150         },
 151         {
 152             name => "privatename",
 153             data_type => "varchar",
 154             default_value => undef,
 155             is_nullable => 1,
 156         },
 157     ],
 158 );
 159
 160 #
 161 # Recording
 162 #
 163 test_table( $scma->get_table("Recording"),
 164     name => "Recording",
 165     fields => [
 166     {
 167         name => "recordingid",
 168         data_type => "int",
 169         default_value => undef,
 170         is_nullable => 1,
 171         is_primary_key => 1,
 172     },
 173     {
 174         name => "title",
 175         data_type => "varchar",
 176         is_nullable => 1,
 177     },
 178     {
 179         name => "type",
 180         data_type => "varchar",
 181         is_nullable => 1,
 182     },
 183     ],
 184 );
 185
 186 #
 187 # Track
 188 #
 189 test_table( $scma->get_table("Track"),
 190     name => "Track",
 191     fields => [
 192     {
 193         name => "trackid",
 194         data_type => "int",
 195         default_value => undef,
 196         is_nullable => 1,
 197         is_primary_key => 1,
 198     },
 199     {
 200         name => "recordingid",
 201         data_type => "int",
 202         default_value => undef,
 203         is_nullable => 1,
 204         is_primary_key => 0,
 205         #is_foreign_key => 1,
 206     },
 207     {
 208         name => "number",
 209         data_type => "int",
 210         default_value => "1",
 211         is_nullable => 1,
 212     },
 213     {
 214         name => "name",
 215         data_type => "varchar",
 216         is_nullable => 1,
 217     },
 218     ],
 219 );