t/22xml-xmi-parser-visibility.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 => 8;
  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 # Visibility tests
  99 #
 100
 101 # Classes
 102 my @testd = (
 103     ""          => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
 104                    [qw/fooid name protectedname privatename/],
 105     "public"    => [qw/Foo Recording CD Track/],
 106                    [qw/fooid name /],
 107     "protected" => [qw/Foo Recording CD Track ProtectedFoo/],
 108                    [qw/fooid name protectedname/],
 109     "private"   => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
 110                    [qw/fooid name protectedname privatename/],
 111 );
 112     while ( my ($vis,$tables,$foofields) = splice @testd,0,3 ) {
 113     my $obj;
 114     $obj = SQL::Translator->new(
 115         filename => $testschema,
 116         from     => 'XML-XMI',
 117         to       => 'MySQL',
 118         debug          => DEBUG,
 119         show_warnings  => 1,
 120         add_drop_table => 1,
 121         parser_args => {
 122             visibility => $vis,
 123         },
 124     );
 125     my $sql = $obj->translate;
 126     my $scma = $obj->schema;
 127
 128     my @tblnames = map {$_->name} $scma->get_tables;
 129     is_deeply( \@tblnames, $tables, "Tables with visibility => '$vis'");
 130
 131     my @fldnames = map {$_->name} $scma->get_table("Foo")->get_fields;
 132     is_deeply( \@fldnames, $foofields, "Foo fields with visibility => '$vis'");
 133
 134     #print "Debug: translator", Dumper($obj) if DEBUG;
 135     #print "Debug: schema", Dumper($obj->schema) if DEBUG;
 136 }