X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F17sqlfxml-producer.t;h=31bbf0c479ea2912499e3b9678d2226beeeb5465;hb=8ce5d6158b9fb1e09bda97b1061eea5232c268ad;hp=64c90c793d57aa96a2b6763fb9e090507324da46;hpb=d0c12b9f6bdd463df6be643db1981e995a10dfbe;p=dbsrgits%2FSQL-Translator.git diff --git a/t/17sqlfxml-producer.t b/t/17sqlfxml-producer.t index 64c90c7..31bbf0c 100644 --- a/t/17sqlfxml-producer.t +++ b/t/17sqlfxml-producer.t @@ -1,15 +1,18 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl -w # vim:filetype=perl # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +local $^W = 0; + use strict; use Test::More; use Test::Exception; +use Test::SQL::Translator qw(maybe_plan); use Data::Dumper; -our %opt; +my %opt; BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } use constant DEBUG => (exists $opt{d} ? 1 : 0); use constant TRACE => (exists $opt{t} ? 1 : 0); @@ -18,115 +21,75 @@ use FindBin qw/$Bin/; my $file = "$Bin/data/mysql/sqlfxml-producer-basic.sql"; +local $SIG{__WARN__} = sub { + CORE::warn(@_) + unless $_[0] =~ m!XML/Writer!; +}; # Testing 1,2,3,4... #============================================================================= -eval { require XML::Writer; }; -if ($@ && $@ =~ m!locate XML::Writer.pm in!) { - plan skip_all => "You need XML::Writer to use SqlfXML."; -} -eval { require Test::Differences; }; -if ($@ && $@ =~ m!locate Test/Differences.pm in!) { - plan skip_all => "You need Test::Differences for this test."; +BEGIN { + maybe_plan(14, + 'XML::Writer', + 'Test::Differences', + 'SQL::Translator::Producer::XML::SQLFairy'); } + use Test::Differences; -plan tests => 6; - use SQL::Translator; -use SQL::Translator::Producer::SqlfXML; - -my ($obj,$ans,$xml); +use SQL::Translator::Producer::XML::SQLFairy; # -# emit_empty_tags => 0 +# basic stuff # +{ +my ($obj,$ans,$xml); $ans = < - - Basic - 1 - - - id - integer - 1 - 1 - 0 - 0 - 1 - 10 - - - title - varchar - hello - 0 - 0 - 0 - 0 - 2 - 100 - - - description - text - - 0 - 0 - 1 - 0 - 3 - 0 - - - email - varchar - 0 - 0 - 1 - 0 - 4 - 255 - - - - - title - titleindex - - NORMAL - - - - - 1 - - id - - - - - - - PRIMARY KEY - - - 1 - - email - - - - - - - UNIQUE - - - - + + + + + + + + + comment on id field + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + EOXML $obj = SQL::Translator->new( @@ -135,137 +98,240 @@ $obj = SQL::Translator->new( show_warnings => 1, add_drop_table => 1, from => "MySQL", - to => "SqlfXML", + to => "XML-SQLFairy", ); -lives_ok { $xml = $obj->translate($file); } "Translate ran"; +$xml = $obj->translate($file) or die $obj->error; ok("$xml" ne "" ,"Produced something!"); print "XML:\n$xml" if DEBUG; # Strip sqlf header with its variable date so we diff safely -$xml =~ s/^([^\n]*\n){7}//m; -eq_or_diff $xml, $ans ,"XML looks right"; +$xml =~ s/^([^\n]*\n){7}//m; +eq_or_diff $xml, $ans, "XML looks right"; + +} # end basic stuff # -# emit_empty_tags => 1 +# View # +# Thanks to Ken for the schema setup lifted from 13schema.t +{ +my ($obj,$ans,$xml); $ans = < - - Basic - 2 - - - id - integer - - 1 - 1 - 0 - 0 - 5 - 10 - - - title - varchar - hello - 0 - 0 - 0 - 0 - 6 - 100 - - - description - text - - 0 - 0 - 1 - 0 - 7 - 0 - - - email - varchar - - 0 - 0 - 1 - 0 - 8 - 255 - - - - - title - titleindex - - NORMAL - - - - - 1 - - id - - - - - - - - PRIMARY KEY - - - 1 - - email - - - - - - - - UNIQUE - - - - + + + + + + select name, age from person + + + + + + EOXML -undef $obj; -$obj = SQL::Translator->new( - debug => DEBUG, - trace => TRACE, - show_warnings => 1, - add_drop_table => 1, - from => "MySQL", - to => "SqlfXML", - producer_args => { emit_empty_tags => 1 }, -); -lives_ok { $xml = $obj->translate($file); } "Translate ran"; -ok("$xml" ne "" ,"Produced something!"); -print "XML emit_empty_tags=>1:\n$xml" if DEBUG; -# Strip sqlf header with its variable date so we diff safely -$xml =~ s/^([^\n]*\n){7}//m; -eq_or_diff $xml, $ans ,"XML looks right"; - # This diff probably isn't a very good test! Should really check the - # result with XPath or something, but that would take ages to write ;-) + $obj = SQL::Translator->new( + debug => DEBUG, + trace => TRACE, + show_warnings => 1, + add_drop_table => 1, + from => "MySQL", + to => "XML-SQLFairy", + ); + my $s = $obj->schema; + my $name = 'foo_view'; + my $sql = 'select name, age from person'; + my $fields = 'name, age'; + my $v = $s->add_view( + name => $name, + sql => $sql, + fields => $fields, + extra => { hello => "world" }, + schema => $s, + ) or die $s->error; -#print "Debug:", Dumper($obj) if DEBUG; -$obj = SQL::Translator->new( - debug => DEBUG, - trace => TRACE, - show_warnings => 1, - add_drop_table => 1, - from => "MySQL", - to => "SqlfXML", - producer_args => { emit_empty_tags => 0 }, -); -print $obj->translate("/home/grommit/src/NADS-build/sql/document.mysql.sql"); + # As we have created a Schema we give translate a dummy string so that + # it will run the produce. + lives_ok {$xml =$obj->translate("FOO");} "Translate (View) ran"; + ok("$xml" ne "" ,"Produced something!"); + print "XML attrib_values=>1:\n$xml" if DEBUG; + # Strip sqlf header with its variable date so we diff safely + $xml =~ s/^([^\n]*\n){7}//m; + eq_or_diff $xml, $ans ,"XML looks right"; +} # end View + +# +# Trigger +# +# Thanks to Ken for the schema setup lifted from 13schema.t +{ +my ($obj,$ans,$xml); + +$ans = < + + + + + + + + +
+ + + + + update modified=timestamp(); + + + + + +EOXML + + $obj = SQL::Translator->new( + debug => DEBUG, + trace => TRACE, + show_warnings => 1, + add_drop_table => 1, + from => "MySQL", + to => "XML-SQLFairy", + ); + my $s = $obj->schema; + my $name = 'foo_trigger'; + my $perform_action_when = 'after'; + my $database_event = 'insert'; + my $action = 'update modified=timestamp();'; + my $table = $s->add_table( name => "Basic" ) or die $s->error; + my $t = $s->add_trigger( + name => $name, + perform_action_when => $perform_action_when, + database_event => $database_event, + table => $table, + action => $action, + extra => { hello => "world" }, + ) or die $s->error; + + # As we have created a Schema we give translate a dummy string so that + # it will run the produce. + lives_ok {$xml =$obj->translate("FOO");} "Translate (Trigger) ran"; + ok("$xml" ne "" ,"Produced something!"); + print "XML attrib_values=>1:\n$xml" if DEBUG; + # Strip sqlf header with its variable date so we diff safely + $xml =~ s/^([^\n]*\n){7}//m; + eq_or_diff $xml, $ans ,"XML looks right"; +} # end Trigger + +# +# Procedure +# +# Thanks to Ken for the schema setup lifted from 13schema.t +{ +my ($obj,$ans,$xml); + +$ans = < + + + + + + + select foo from bar + Go Sox! + + + + +EOXML + + $obj = SQL::Translator->new( + debug => DEBUG, + trace => TRACE, + show_warnings => 1, + add_drop_table => 1, + from => "MySQL", + to => "XML-SQLFairy", + ); + my $s = $obj->schema; + my $name = 'foo_proc'; + my $sql = 'select foo from bar'; + my $parameters = 'foo, bar'; + my $owner = 'Nomar'; + my $comments = 'Go Sox!'; + my $p = $s->add_procedure( + name => $name, + sql => $sql, + parameters => $parameters, + owner => $owner, + comments => $comments, + extra => { hello => "world" }, + ) or die $s->error; + + # As we have created a Schema we give translate a dummy string so that + # it will run the produce. + lives_ok {$xml =$obj->translate("FOO");} "Translate (Procedure) ran"; + ok("$xml" ne "" ,"Produced something!"); + print "XML attrib_values=>1:\n$xml" if DEBUG; + # Strip sqlf header with its variable date so we diff safely + $xml =~ s/^([^\n]*\n){7}//m; + eq_or_diff $xml, $ans ,"XML looks right"; +} # end Procedure + +# +# Field.extra +# +{ +my ($obj,$ans,$xml); + +$ans = < + + + + + + + + + + + + + +
+ + + + + +EOXML + + $obj = SQL::Translator->new( + debug => DEBUG, + trace => TRACE, + show_warnings => 1, + add_drop_table => 1, + from => "MySQL", + to => "XML-SQLFairy", + ); + my $s = $obj->schema; + my $t = $s->add_table( name => "Basic" ) or die $s->error; + my $f = $t->add_field( + name => "foo", + data_type => "integer", + size => "10", + ) or die $t->error; + $f->extra(ZEROFILL => "1"); + + # As we have created a Schema we give translate a dummy string so that + # it will run the produce. + lives_ok {$xml =$obj->translate("FOO");} "Translate (Field.extra) ran"; + ok("$xml" ne "" ,"Produced something!"); + print "XML:\n$xml" if DEBUG; + # Strip sqlf header with its variable date so we diff safely + $xml =~ s/^([^\n]*\n){7}//m; + eq_or_diff $xml, $ans ,"XML looks right"; +} # end extra