X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F17sqlfxml-producer.t;h=21722a7a723de5847bbe565d40507b37be89031d;hb=446dfcbd3a58ad65602cd45c25155bc91d7e25a4;hp=0ac36c5a5ad519693e5e7e7b578ba1060dcfa769;hpb=a8e0cc1a65094b19ae58e50eb1b65389f6c67a73;p=dbsrgits%2FSQL-Translator.git diff --git a/t/17sqlfxml-producer.t b/t/17sqlfxml-producer.t index 0ac36c5..21722a7 100644 --- a/t/17sqlfxml-producer.t +++ b/t/17sqlfxml-producer.t @@ -4,12 +4,14 @@ # 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 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); @@ -24,69 +26,76 @@ my $file = "$Bin/data/mysql/sqlfxml-producer-basic.sql"; eval { require XML::Writer; }; if ($@ && $@ =~ m!locate XML::Writer.pm in!) { - plan skip_all => "You need XML::Writer to use SqlfXML."; + plan skip_all => "You need XML::Writer to use XML::SQLFairy."; } eval { require Test::Differences; }; if ($@ && $@ =~ m!locate Test/Differences.pm in!) { plan skip_all => "You need Test::Differences for this test."; } use Test::Differences; -plan tests => 6; +plan tests => 18; use SQL::Translator; -use SQL::Translator::Producer::SqlfXML; +use SQL::Translator::Producer::XML::SQLFairy; -my ($obj,$ans,$xml); # # emit_empty_tags => 0 # +{ +my ($obj,$ans,$xml); $ans = < + + Basic 1 - id + comment on id field integer 1 - 1 - 0 0 + 0 + 1 + id 1 10 - title + varchar hello 0 - 0 - 0 0 + 0 + 0 + title 2 100 - description + text 0 - 0 - 1 0 + 1 + 0 + description 3 - 0 + 65535 - email + varchar 0 - 0 - 1 0 + 1 + 0 + email 4 255 @@ -106,9 +115,9 @@ $ans = <id - + PRIMARY KEY @@ -118,9 +127,9 @@ $ans = <email - + UNIQUE @@ -134,67 +143,77 @@ $obj = SQL::Translator->new( trace => TRACE, show_warnings => 1, add_drop_table => 1, - from => "MySQL", - to => "SqlfXML", + from => 'MySQL', + to => 'XML-SQLFairy', ); -lives_ok { $xml = $obj->translate($file); } "Translate ran"; +lives_ok {$xml = $obj->translate($file);} "Translate (emit_empty_tags=>0) 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 emit_empty_tags=>0 + # # emit_empty_tags => 1 # +{ +my ($obj,$ans,$xml); $ans = < + + Basic 2 - id + comment on id field integer 1 - 1 - 0 0 + 0 + 1 + id 5 10 - title + varchar hello 0 - 0 - 0 0 + 0 + 0 + title 6 100 - description + text 0 - 0 - 1 0 + 1 + 0 + description 7 - 0 + 65535 - email + varchar 0 - 0 - 1 0 + 1 + 0 + email 8 255 @@ -214,9 +233,9 @@ $ans = <id - + PRIMARY KEY @@ -227,9 +246,9 @@ $ans = <email - + UNIQUE @@ -239,33 +258,221 @@ $ans = < EOXML -undef $obj; $obj = SQL::Translator->new( debug => DEBUG, trace => TRACE, show_warnings => 1, add_drop_table => 1, - from => "MySQL", - to => "SqlfXML", + from => 'MySQL', + to => 'XML-SQLFairy', producer_args => { emit_empty_tags => 1 }, ); -lives_ok { $xml = $obj->translate($file); } "Translate ran"; +lives_ok { $xml=$obj->translate($file); } "Translate (emit_empty_tags=>1) 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 ;-) -# TODO Make this a real test of attrib_values -# $obj = SQL::Translator->new( -# debug => DEBUG, -# trace => TRACE, -# show_warnings => 1, -# add_drop_table => 1, -# from => "MySQL", -# to => "SqlfXML", -# producer_args => { attrib_values => 1 }, -# ); -# print $obj->translate($file); +} # end emit_empty_tags => 1 + +# +# attrib_values => 1 +# +{ +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", + producer_args => { attrib_values => 1 }, +); +lives_ok {$xml = $obj->translate($file);} "Translate (attrib_values=>1) 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 attrib_values => 1 + +# +# View +# +# Thanks to Ken for the schema setup lifted from 13schema.t +{ +my ($obj,$ans,$xml); + +$ans = < + + + + name,age + foo_view + 1 + select name, age from person + + +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_view'; + my $sql = 'select name, age from person'; + my $fields = 'name, age'; + my $v = $s->add_view( + name => $name, + sql => $sql, + fields => $fields, + schema => $s, + ) 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 (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(); + insert + foo_trigger + foo + 1 + after + + +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 $on_table = 'foo'; + my $action = 'update modified=timestamp();'; + my $t = $s->add_trigger( + name => $name, + perform_action_when => $perform_action_when, + database_event => $database_event, + on_table => $on_table, + action => $action, + ) 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 = < + + + + Go Sox! + foo_proc + 1 + Nomar + foo,bar + select foo from bar + + +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, + ) 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