t/16xml-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 Test::More;
  14 use Test::Exception;
  15
  16 use strict;
  17 use Data::Dumper;
  18 our %opt;
  19 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
  20 use constant DEBUG => (exists $opt{d} ? 1 : 0);
  21 local $SIG{__WARN__} = sub { diag "[warn] ", @_; };
  22
  23 use FindBin qw/$Bin/;
  24
  25 # Usefull test subs for the schema objs
  26 #=============================================================================
  27
  28 our %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     is $fld->name, $name, "$name - Name right";
  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 # TODO test_constraint, test_index
  66
  67 # Testing 1,2,3,4...
  68 #=============================================================================
  69
  70 plan tests => 162;
  71
  72 use SQL::Translator;
  73 use SQL::Translator::Schema::Constants;
  74
  75 foreach (
  76     "$Bin/data/xml/schema-basic.xml",
  77     "$Bin/data/xml/schema-basic-attribs.xml"
  78 ) {
  79     do_file($_);
  80 }
  81
  82 sub do_file {
  83     my $testschema = shift;
  84     # Parse the test XML schema
  85     our $obj;
  86     $obj = SQL::Translator->new(
  87         debug          => DEBUG,
  88         show_warnings  => 1,
  89         add_drop_table => 1,
  90     );
  91     die "Can't find test schema $testschema" unless -e $testschema;
  92     my $sql = $obj->translate(
  93         from     => "SqlfXML",
  94         to       =>"MySQL",
  95         filename => $testschema,
  96     );
  97     print $sql if DEBUG;
  98     #print "Debug:", Dumper($obj) if DEBUG;
  99
 100     # Test the schema objs generted from the XML
 101     #
 102     my $scma = $obj->schema;
 103     my @tblnames = map {$_->name} $scma->get_tables;
 104     is_deeply( \@tblnames, [qw/Basic/], "tables");
 105
 106     # Basic
 107     my $tbl = $scma->get_table("Basic");
 108     is_deeply( [map {$_->name} $tbl->get_fields], [qw/
 109         id title description email explicitnulldef explicitemptystring emptytagdef
 110     /] , "Table Basic's fields");
 111     test_field($tbl->get_field("id"),{
 112         name => "id",
 113         data_type => "int",
 114         default_value => undef,
 115         is_nullable => 0,
 116         size => 10,
 117         is_primary_key => 1,
 118         is_auto_increment => 1,
 119     });
 120     test_field($tbl->get_field("title"),{
 121         name => "title",
 122         data_type => "varchar",
 123         is_nullable => 0,
 124         default_value => "hello",
 125         size => 100,
 126     });
 127     test_field($tbl->get_field("description"),{
 128         name => "description",
 129         data_type => "text",
 130         is_nullable => 1,
 131         default_value => "",
 132     });
 133     test_field($tbl->get_field("email"),{
 134         name => "email",
 135         data_type => "varchar",
 136         size => 255,
 137         is_unique => 1,
 138         default_value => undef,
 139         is_nullable => 1,
 140     });
 141     test_field($tbl->get_field("explicitnulldef"),{
 142         name => "explicitnulldef",
 143         data_type => "varchar",
 144         default_value => undef,
 145         is_nullable => 1,
 146     });
 147     test_field($tbl->get_field("explicitemptystring"),{
 148         name => "explicitemptystring",
 149         data_type => "varchar",
 150         default_value => "",
 151         is_nullable => 1,
 152     });
 153     test_field($tbl->get_field("emptytagdef"),{
 154         name => "emptytagdef",
 155         data_type => "varchar",
 156         default_value => "",
 157         is_nullable => 1,
 158     });
 159
 160     my @indices = $tbl->get_indices;
 161     is scalar(@indices), 1, "Table basic has 1 index";
 162
 163     my @constraints = $tbl->get_constraints;
 164     is scalar(@constraints), 2, "Table basic has 2 constraints";
 165     my $con = shift @constraints;
 166     is $con->table, $tbl, "Constaints table right";
 167     is $con->name, "", "Constaints table right";
 168     is $con->type, PRIMARY_KEY, "Constaint is primary key";
 169     is_deeply [$con->fields], ["id"], "Constaint fields";
 170     $con = shift @constraints;
 171     is $con->table, $tbl, "Constaints table right";
 172     is $con->type, UNIQUE, "Constaint UNIQUE";
 173     is_deeply [$con->fields], ["email"], "Constaint fields";
 174 } # /Test of schema