X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F16xml-parser.t;h=a863ba4ec733a35e58dc6076fbdf92a75219c385;hb=1c375f480a1472ac584677277d2049e674bcbd1e;hp=be7372aa4f1d2f3e3e3bb77340bfc7a647a8ce85;hpb=5ff70f1ac9dd66a8fec633b4ec71fa6a395fa210;p=dbsrgits%2FSQL-Translator.git

diff --git a/t/16xml-parser.t b/t/16xml-parser.t
index be7372a..a863ba4 100644
--- a/t/16xml-parser.t
+++ b/t/16xml-parser.t
@@ -3,163 +3,169 @@
 
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
-
-#
-# basic.t
-# -------
-# Tests that;
 #
-
-use Test::More tests => 78;
-use Test::Exception;
+# Run script with -d for debug.
 
 use strict;
-use Data::Dumper;
-our %opt;
-BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
-use constant DEBUG => (exists $opt{d} ? 1 : 0);
-local $SIG{__WARN__} = sub { diag "[warn] ", @_; };
 
 use FindBin qw/$Bin/;
 
-# Usefull test subs for the schema objs
-#=============================================================================
+use Test::More;
+use Test::SQL::Translator;
+use Test::Exception;
+use Data::Dumper;
+use SQL::Translator;
+use SQL::Translator::Schema::Constants;
 
-our %ATTRIBUTES;
-$ATTRIBUTES{field} = [qw/
-name
-order
-data_type
-default_value
-size
-is_primary_key
-is_unique
-is_nullable
-is_foreign_key
-is_auto_increment
-/];
-
-sub test_field {
-    my ($fld,$test) = @_;
-    die "test_field needs a least a name!" unless $test->{name};
-    my $name = $test->{name};
-    is $fld->name, $name, "$name - Name right";
-
-    foreach my $attr ( @{$ATTRIBUTES{field}} ) {
-        if ( exists $test->{$attr} ) {
-            my $ans = $test->{$attr};
-            if ( $attr =~ m/^is_/ ) {
-                if ($ans) { ok $fld->$attr,  " $name - $attr true"; }
-                else      { ok !$fld->$attr, " $name - $attr false"; }
-            }
-            else {
-                is $fld->$attr, $ans, " $name - $attr = '"
-                                     .(defined $ans ? $ans : "NULL" )."'";
-            }
-        }
-        else {
-            ok !$fld->$attr, "$name - $attr not set";
-        }
-    }
-}
+# Simple options. -d for debug
+my %opt;
+BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
+use constant DEBUG => (exists $opt{d} ? 1 : 0);
 
-# TODO test_constraint, test_index
 
 # Testing 1,2,3,4...
 #=============================================================================
 
-use SQL::Translator;
-use SQL::Translator::Schema::Constants;
+plan tests => 274;
 
-# Parse the test XML schema
-our $obj;
-$obj = SQL::Translator->new(
-    debug          => DEBUG,
-    show_warnings  => 1,
-    add_drop_table => 1,
-);
-my $testschema = "$Bin/data/xml/schema-basic.xml";
-die "Can't find test schema $testschema" unless -e $testschema;
-my $sql = $obj->translate(
-    from     => "SqlfXML",
-    to       =>"MySQL",
-    filename => $testschema,
-);
-print $sql if DEBUG;
-#print "Debug:", Dumper($obj) if DEBUG;
-
-# Test the schema objs generted from the XML
-#
-my $scma = $obj->schema;
-my @tblnames = map {$_->name} $scma->get_tables;
-is_deeply( \@tblnames, [qw/Basic/], "tables");
-
-# Basic
-my $tbl = $scma->get_table("Basic");
-is $tbl->order, 1, "Basic->order";
-is_deeply( [map {$_->name} $tbl->get_fields],
-    [qw/id title description email explicitnulldef explicitemptystring/] , 
-    "Table Basic's fields");
-test_field($tbl->get_field("id"),{
-    name => "id",
-    order => 1,
-    data_type => "int",
-    default_value => undef,
-    is_nullable => 0,
-    size => 10,
-    is_primary_key => 1,
-    is_auto_increment => 1,
-});
-test_field($tbl->get_field("title"),{
-    name => "title",
-    order => 2,
-    data_type => "varchar",
-    is_nullable => 0,
-    default_value => "hello",
-    size => 100,
-});
-test_field($tbl->get_field("description"),{
-    name => "description",
-    order => 3,
-    data_type => "text",
-    is_nullable => 1,
-    default_value => "",
-});
-test_field($tbl->get_field("email"),{
-    name => "email",
-    order => 4,
-    data_type => "varchar",
-    size => 255,
-    is_unique => 1,
-    default_value => undef,
-    is_nullable => 1,
-});
-test_field($tbl->get_field("explicitnulldef"),{
-    name => "explicitnulldef",
-    order => 5,
-    data_type => "varchar",
-    default_value => undef,
-    is_nullable => 1,
-});
-test_field($tbl->get_field("explicitemptystring"),{
-    name => "explicitemptystring",
-    order => 6,
-    data_type => "varchar",
-    default_value => "",
-    is_nullable => 1,
-});
-
-my @indices = $tbl->get_indices;
-is scalar(@indices), 1, "Table basic has 1 index";
-
-my @constraints = $tbl->get_constraints;
-is scalar(@constraints), 2, "Table basic has 2 constraints";
-my $con = shift @constraints;
-is $con->table, $tbl, "Constaints table right";
-is $con->name, "", "Constaints table right";
-is $con->type, PRIMARY_KEY, "Constaint is primary key";
-is_deeply [$con->fields], ["id"], "Constaint fields";
-$con = shift @constraints;
-is $con->table, $tbl, "Constaints table right";
-is $con->type, UNIQUE, "Constaint UNIQUE";
-is_deeply [$con->fields], ["email"], "Constaint fields";
+foreach (
+    "$Bin/data/xml/schema-basic.xml",
+    "$Bin/data/xml/schema-basic-attribs.xml"
+) {
+    do_file($_);
+}
+
+sub do_file {
+    my $testschema = shift;
+    # Parse the test XML schema
+    my $obj;
+    $obj = SQL::Translator->new(
+        debug          => DEBUG,
+        show_warnings  => 1,
+        add_drop_table => 1,
+    );
+    die "Can't find test schema $testschema" unless -e $testschema;
+    my $sql = $obj->translate(
+        from     => 'XML-SQLFairy',
+        to       => 'MySQL',
+        filename => $testschema,
+    );
+    print $sql if DEBUG;
+
+    # Test the schema objs generted from the XML
+    #
+    my $scma = $obj->schema;
+    my @tblnames = map {$_->name} $scma->get_tables;
+    is_deeply( \@tblnames, [qw/Basic/], "tables");
+
+    # Basic
+    my $tbl = $scma->get_table("Basic");
+    is_deeply( [map {$_->name} $tbl->get_fields], [qw/
+        id title description email explicitnulldef explicitemptystring emptytagdef
+    /] , "Table Basic's fields");
+
+    table_ok( $scma->get_table("Basic"), {
+        name => "Basic",
+        fields => [
+        {
+            name => "id",
+            data_type => "int",
+            default_value => undef,
+            is_nullable => 0,
+            size => 10,
+            is_primary_key => 1,
+            is_auto_increment => 1,
+        },
+        {
+            name => "title",
+            data_type => "varchar",
+            is_nullable => 0,
+            default_value => "hello",
+            size => 100,
+        },
+        {
+            name => "description",
+            data_type => "text",
+            is_nullable => 1,
+            default_value => "",
+        },
+        {
+            name => "email",
+            data_type => "varchar",
+            size => 255,
+            is_unique => 1,
+            default_value => undef,
+            is_nullable => 1,
+        },
+        {
+            name => "explicitnulldef",
+            data_type => "varchar",
+            default_value => undef,
+            is_nullable => 1,
+        },
+        {
+            name => "explicitemptystring",
+            data_type => "varchar",
+            default_value => "",
+            is_nullable => 1,
+        },
+        {
+            name => "emptytagdef",
+            data_type => "varchar",
+            default_value => "",
+            is_nullable => 1,
+        },
+        ],
+        constraints => [
+        {
+            type => PRIMARY_KEY,
+            fields => ["id"],
+        },
+        {
+            name => 'emailuniqueindex',
+            type => UNIQUE,
+            fields => ["email"],
+        }
+        ],
+        indices => [
+        {
+            name => "titleindex",
+            fields => ["title"],
+        },
+        ],
+    });
+
+    #
+    # View
+    #
+    my @views = $scma->get_views;
+    view_ok( $views[0], {
+        name => 'email_list',
+        sql => "SELECT email FROM Basic WHERE email IS NOT NULL",
+        fields => ['email'],
+    });
+
+    my @triggs = $scma->get_triggers;
+    trigger_ok( $triggs[0], {
+        name                => 'foo_trigger',
+        perform_action_when => 'after',
+        database_event      => 'insert',
+        on_table            => 'foo',
+        action              => 'update modified=timestamp();',
+    });
+
+
+    #
+    # Procedure
+    #
+    my @procs = $scma->get_procedures;
+    procedure_ok( $procs[0], {
+        name       => 'foo_proc',
+        sql        => 'select foo from bar',
+        parameters => ['foo', 'bar'],
+        owner      => 'Nomar',
+        comments   => 'Go Sox!',
+    });
+
+    print "Debug:", Dumper($obj) if DEBUG;
+} # /Test of schema