From: Mark Addison Date: Mon, 20 Oct 2003 14:26:02 +0000 (+0000) Subject: Added Views, Procedures and Triggers to bring it inline with the current Schema featu... X-Git-Tag: v0.04~37 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=19922fbc689789d47006f105b6678644f4a1c673;p=dbsrgits%2FSQL-Translator.git Added Views, Procedures and Triggers to bring it inline with the current Schema features and updated producer. --- diff --git a/lib/SQL/Translator/Parser/XML/SQLFairy.pm b/lib/SQL/Translator/Parser/XML/SQLFairy.pm index 9f4137d..fd25cc2 100644 --- a/lib/SQL/Translator/Parser/XML/SQLFairy.pm +++ b/lib/SQL/Translator/Parser/XML/SQLFairy.pm @@ -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 , # @@ -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' ); diff --git a/t/16xml-parser.t b/t/16xml-parser.t index ebf3323..dab4d92 100644 --- a/t/16xml-parser.t +++ b/t/16xml-parser.t @@ -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 diff --git a/t/data/xml/schema-basic-attribs.xml b/t/data/xml/schema-basic-attribs.xml index dc33687..a18b8e6 100644 --- a/t/data/xml/schema-basic-attribs.xml +++ b/t/data/xml/schema-basic-attribs.xml @@ -36,4 +36,30 @@ Created on Fri Aug 15 15:08:18 2003 + + + + + + + diff --git a/t/data/xml/schema-basic.xml b/t/data/xml/schema-basic.xml index 2664312..8db834d 100644 --- a/t/data/xml/schema-basic.xml +++ b/t/data/xml/schema-basic.xml @@ -82,4 +82,29 @@ Created on Fri Aug 1 11:24:58 2003 + + email + email_list + 1 + SELECT email FROM Basic WHERE email IS NOT NULL + + + + update modified=timestamp(); + insert + foo_trigger + foo + 1 + after + + + + Go Sox! + foo_proc + 1 + Nomar + foo,bar + select foo from bar + +