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>,
#
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;
}
}
- 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'};
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;
}
#
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;
}
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' );
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" )."'";
}
}
# Testing 1,2,3,4...
#=============================================================================
-plan tests => 162;
+plan tests => 198;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
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
</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>