Added Views, Procedures and Triggers to bring it inline with the current Schema featu...
Mark Addison [Mon, 20 Oct 2003 14:26:02 +0000 (14:26 +0000)]
lib/SQL/Translator/Parser/XML/SQLFairy.pm
t/16xml-parser.t
t/data/xml/schema-basic-attribs.xml
t/data/xml/schema-basic.xml

index 9f4137d..fd25cc2 100644 (file)
@@ -1,7 +1,7 @@
 package SQL::Translator::Parser::XML::SQLFairy;
 
 # -------------------------------------------------------------------
-# $Id: SQLFairy.pm,v 1.3 2003-08-26 21:41:21 kycl4rk Exp $
+# $Id: SQLFairy.pm,v 1.4 2003-10-20 14:26:01 grommit Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
 #
@@ -85,7 +85,7 @@ Doesn't take any extra parser args at the moment.
 use strict;
 
 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
@@ -151,7 +151,7 @@ sub parse {
                 }
             }
 
-            my $field = $table->add_field( %fdata ) or die $schema->error;
+            my $field = $table->add_field( %fdata ) or die $table->error;
 
             $table->primary_key( $field->name ) if $fdata{'is_primary_key'};
 
@@ -172,7 +172,7 @@ sub parse {
                 qw/name type table fields reference_fields reference_table
                 match_type on_delete_do on_update_do/
             );
-            $table->add_constraint( %data ) or die $schema->error;
+            $table->add_constraint( %data ) or die $table->error;
         }
 
         #
@@ -182,11 +182,44 @@ sub parse {
         foreach (@nodes) {
             my %data = get_tagfields($xp, $_, "sqlf:",
                 qw/name type fields options/);
-            $table->add_index( %data ) or die $schema->error;
+            $table->add_index( %data ) or die $table->error;
         }
 
     } # tables loop
 
+    #
+    # Views
+    #
+    @nodes = $xp->findnodes('/sqlf:schema/sqlf:view');
+    foreach (@nodes) {
+        my %data = get_tagfields($xp, $_, "sqlf:",
+            qw/name sql fields order/
+        );
+        $schema->add_view( %data ) or die $schema->error;
+    }
+    
+    #
+    # Triggers
+    #
+    @nodes = $xp->findnodes('/sqlf:schema/sqlf:trigger');
+    foreach (@nodes) {
+        my %data = get_tagfields($xp, $_, "sqlf:",
+        qw/name perform_action_when database_event fields on_table action order/
+        );
+        $schema->add_trigger( %data ) or die $schema->error;
+    }
+    
+    #
+    # Procedures
+    #
+    @nodes = $xp->findnodes('/sqlf:schema/sqlf:procedure');
+    foreach (@nodes) {
+        my %data = get_tagfields($xp, $_, "sqlf:",
+        qw/name sql parameters owner comments order/
+        );
+        $schema->add_procedure( %data ) or die $schema->error;
+    }
+    
     return 1;
 }
 
@@ -208,7 +241,7 @@ sub get_tagfields {
         my $thisns = (s/(^.*?:)// ? $1 : $ns);
 
         foreach my $path ( "\@$thisns$_", "$thisns$_" ) {
-            $data{ $_ } = $xp->findvalue( $path, $node ) 
+            $data{ $_ } = "".$xp->findvalue( $path, $node ) 
                 if $xp->exists( $path, $node );
 
             debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
index ebf3323..dab4d92 100644 (file)
@@ -49,11 +49,11 @@ sub test_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"; }
+                if ($ans) { ok $fld->$attr,  "$name - $attr true"; }
+                else      { ok !$fld->$attr, "$name - $attr false"; }
             }
             else {
-                is $fld->$attr, $ans, " $name - $attr = '"
+                is $fld->$attr, $ans, "$name - $attr = '"
                                      .(defined $ans ? $ans : "NULL" )."'";
             }
         }
@@ -68,7 +68,7 @@ sub test_field {
 # Testing 1,2,3,4...
 #=============================================================================
 
-plan tests => 162;
+plan tests => 198;
 
 use SQL::Translator;
 use SQL::Translator::Schema::Constants;
@@ -172,4 +172,58 @@ sub do_file {
     is $con->table, $tbl, "Constaints table right";
     is $con->type, UNIQUE, "Constaint UNIQUE";
     is_deeply [$con->fields], ["email"], "Constaint fields";
+
+    #
+    # View
+    # 
+    my @views = $scma->get_views;
+    is( scalar @views, 1, 'Number of views is 1' );
+    my $v = $views[0];
+    isa_ok( $v, 'SQL::Translator::Schema::View', 'View' );
+    is( $v->name, 'email_list', "View's Name is 'email_list'" );
+    is( $v->sql, "SELECT email FROM Basic WHERE email IS NOT NULL",
+    "View's sql" );
+    is( join(",",$v->fields), 'email', "View's Fields" );
+
+    #
+    # Trigger
+    #
+    {
+        my $name                = 'foo_trigger';
+        my $perform_action_when = 'after';
+        my $database_event      = 'insert';
+        my $on_table            = 'foo';
+        my $action              = 'update modified=timestamp();';
+        my @triggs = $scma->get_triggers;
+        is( scalar @triggs, 1, 'Number of triggers is 1' );
+        my $t = $triggs[0];
+        isa_ok( $t, 'SQL::Translator::Schema::Trigger', 'Trigger' );
+        is( $t->name, $name, qq[Name is "$name"] );
+        is( $t->perform_action_when, $perform_action_when, 
+            qq[Perform action when is "$perform_action_when"] );
+        is( $t->database_event, $database_event, 
+            qq[Database event is "$database_event"] );
+        is( $t->on_table, $on_table, qq[Table is "$on_table"] );
+        is( $t->action, $action, qq[Action is "$action"] );
+    }
+    
+    #
+    # Procedure
+    #
+    {
+        my $name       = 'foo_proc';
+        my $sql        = 'select foo from bar';
+        my $parameters = 'foo, bar';
+        my $owner      = 'Nomar';
+        my $comments   = 'Go Sox!';
+        my @procs = $scma->get_procedures;
+        is( scalar @procs, 1, 'Number of procedures is 1' );
+        my $p = $procs[0];
+        isa_ok( $p, 'SQL::Translator::Schema::Procedure', 'Procedure' );
+        is( $p->name, $name, qq[Name is "$name"] );
+        is( $p->sql, $sql, qq[SQL is "$sql"] );
+        is( join(',', $p->parameters), 'foo,bar', qq[Params = 'foo,bar'] );
+        is( $p->comments, $comments, qq[Comments = "$comments"] );
+    }
+
 } # /Test of schema
index dc33687..a18b8e6 100644 (file)
@@ -36,4 +36,30 @@ Created on Fri Aug 15 15:08:18 2003
       <sqlt:constraint options="" match_type="" deferrable="1" name="emailuniqueindex" on_update="" reference_table="" on_delete="" fields="email" expression="" type="UNIQUE" />
     </sqlt:constraints>
   </sqlt:table>
+
+  <sqlt:view 
+      name="email_list"
+      sql="SELECT email FROM Basic WHERE email IS NOT NULL"
+      fields="email"
+      order="1"
+  />
+
+  <sqlt:trigger
+    action="update modified=timestamp();"
+    database_event="insert"
+    name="foo_trigger"
+    on_table="foo"
+    order="1"
+    perform_action_when="after"
+  />
+  
+  <sqlt:procedure
+    comments="Go Sox!"
+    name="foo_proc"
+    order="1"
+    owner="Nomar"
+    parameters="foo,bar"
+    sql="select foo from bar"
+  />
+
 </sqlt:schema>
index 2664312..8db834d 100644 (file)
@@ -82,4 +82,29 @@ Created on Fri Aug  1 11:24:58 2003
     </sqlf:constraints>
   </sqlf:table>
   
+  <sqlf:view>
+    <sqlf:fields>email</sqlf:fields>
+    <sqlf:name>email_list</sqlf:name>
+    <sqlf:order>1</sqlf:order>
+    <sqlf:sql>SELECT email FROM Basic WHERE email IS NOT NULL</sqlf:sql>
+  </sqlf:view>
+  
+  <sqlf:trigger>
+    <sqlf:action>update modified=timestamp();</sqlf:action>
+    <sqlf:database_event>insert</sqlf:database_event>
+    <sqlf:name>foo_trigger</sqlf:name>
+    <sqlf:on_table>foo</sqlf:on_table>
+    <sqlf:order>1</sqlf:order>
+    <sqlf:perform_action_when>after</sqlf:perform_action_when>
+  </sqlf:trigger>
+  
+  <sqlf:procedure>
+    <sqlf:comments>Go Sox!</sqlf:comments>
+    <sqlf:name>foo_proc</sqlf:name>
+    <sqlf:order>1</sqlf:order>
+    <sqlf:owner>Nomar</sqlf:owner>
+    <sqlf:parameters>foo,bar</sqlf:parameters>
+    <sqlf:sql>select foo from bar</sqlf:sql>
+  </sqlf:procedure>
+
 </sqlf:schema>