From: Mark Addison Date: Fri, 8 Aug 2003 12:30:20 +0000 (+0000) Subject: Added a test for Producer::SqlfXML. X-Git-Tag: v0.04~347 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d0c12b9f6bdd463df6be643db1981e995a10dfbe;p=dbsrgits%2FSQL-Translator.git Added a test for Producer::SqlfXML. Refactored producer so that the XML for the attributes of the Schema::* objects (::Field ::Table ::Index ::Constraint) is generated by the same sub. Makes testing and tweaking easier :) --- diff --git a/lib/SQL/Translator/Producer/SqlfXML.pm b/lib/SQL/Translator/Producer/SqlfXML.pm index de0949b..b62fd3c 100644 --- a/lib/SQL/Translator/Producer/SqlfXML.pm +++ b/lib/SQL/Translator/Producer/SqlfXML.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::SqlfXML; # ------------------------------------------------------------------- -# $Id: SqlfXML.pm,v 1.2 2003-08-07 16:53:40 grommit Exp $ +# $Id: SqlfXML.pm,v 1.3 2003-08-08 12:30:20 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark , # darren chamberlain , @@ -23,8 +23,13 @@ package SQL::Translator::Producer::SqlfXML; # ------------------------------------------------------------------- use strict; +use warnings; use vars qw[ $VERSION ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; + +use Exporter; +use base qw(Exporter); +our @EXPORT_OK = qw(produce); use IO::Scalar; use SQL::Translator::Utils qw(header_comment); @@ -33,13 +38,17 @@ use XML::Writer; my $namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml'; my $name = 'sqlt'; -# ------------------------------------------------------------------- +{ +our ($translator,$args,$schema); + +sub debug { $translator->debug(@_,"\n"); } # Shortcut. + sub produce { - my $translator = shift; - my $schema = $translator->schema; - my $args = $translator->producer_args; + $translator = shift; + $args = $translator->producer_args; + $schema = $translator->schema; - my $io = IO::Scalar->new; + my $io = IO::Scalar->new; my $xml = XML::Writer->new( OUTPUT => $io, NAMESPACES => 1, @@ -52,34 +61,27 @@ sub produce { $xml->comment(header_comment('', '')); $xml->startTag([ $namespace => 'schema' ]); + # + # Table + # for my $table ( $schema->get_tables ) { - my $table_name = $table->name or next; - $xml->startTag ( [ $namespace => 'table' ] ); - $xml->dataElement( [ $namespace => 'name' ], $table_name ); - $xml->dataElement( [ $namespace => 'order' ], $table->order ); - + debug "Table:",$table->name; + $xml->startTag( [ $namespace => 'table' ] ); + xml_objAttr($xml,$table, qw/name order/); + # # Fields # $xml->startTag( [ $namespace => 'fields' ] ); for my $field ( $table->get_fields ) { + debug " Field:",$field->name; $xml->startTag( [ $namespace => 'field' ] ); - - for my $method ( - qw[ - name data_type default_value is_auto_increment - is_primary_key is_nullable is_foreign_key order size - ] - ) { - my $val = $field->$method; - next unless $args->{emit_empty_tags} || defined $val; - $val = "" if not defined $val; - $xml->dataElement( [ $namespace => $method ], $val ); - } - + xml_objAttr($xml,$field, qw/ + name data_type default_value is_auto_increment + is_primary_key is_nullable is_foreign_key order size + /); $xml->endTag( [ $namespace => 'field' ] ); } - $xml->endTag( [ $namespace => 'fields' ] ); # @@ -87,16 +89,9 @@ sub produce { # $xml->startTag( [ $namespace => 'indices' ] ); for my $index ( $table->get_indices ) { + debug "Index:",$index->name; $xml->startTag( [ $namespace => 'index' ] ); - - for my $method ( qw[ fields name options type ] ) { - my $val = $index->$method; - next unless $args->{emit_empty_tags} || defined $val; - $val = "" if not defined $val; - $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val; - $xml->dataElement( [ $namespace => $method ], $val ) - } - + xml_objAttr($xml,$index, qw/fields name options type/); $xml->endTag( [ $namespace => 'index' ] ); } $xml->endTag( [ $namespace => 'indices' ] ); @@ -106,22 +101,13 @@ sub produce { # $xml->startTag( [ $namespace => 'constraints' ] ); for my $index ( $table->get_constraints ) { + debug "Constraint:",$index->name; $xml->startTag( [ $namespace => 'constraint' ] ); - - for my $method ( - qw[ + xml_objAttr($xml,$index, qw/ deferrable expression fields match_type name options on_delete on_update reference_fields reference_table type - ] - ) { - my $val = $index->$method; - next unless $args->{emit_empty_tags} || defined $val; - $val = "" if not defined $val; - $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val; - $xml->dataElement( [ $namespace => $method ], $val ) - } - + /); $xml->endTag( [ $namespace => 'constraint' ] ); } $xml->endTag( [ $namespace => 'constraints' ] ); @@ -135,6 +121,24 @@ sub produce { return $io; } +# Takes an xml writer, a Schema:: object and a list of methods and adds the +# XML for those methods. +sub xml_objAttr { + my ($xml, $obj, @methods) = @_; + for my $method (@methods) { + my $val = $obj->$method; + debug " ".ref($obj)."->$method=", + (defined $val ? "'$val'" : ""); + next unless $args->{emit_empty_tags} || defined $val; + $val = "" if not defined $val; + $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val; + debug " Adding Attr:".$method."='",$val,"'"; + $xml->dataElement( [ $namespace => $method ], $val ); + } +} + +} # End of our scoped bit + 1; # ------------------------------------------------------------------- @@ -165,9 +169,13 @@ SQL::Translator::Producer::SqlfXML - XML output Creates XML output of a schema. +=head1 TODO + =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE, darren chamberlain Edarren@cpan.orgE +Ken Y. Clark Ekclark@cpan.orgE, +darren chamberlain Edarren@cpan.orgE, +mark addison Emark.addison@itn.co.ukE, =head1 SEE ALSO diff --git a/t/17sqlfxml-producer.t b/t/17sqlfxml-producer.t new file mode 100644 index 0000000..64c90c7 --- /dev/null +++ b/t/17sqlfxml-producer.t @@ -0,0 +1,271 @@ +#!/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' + +use strict; +use Test::More; +use Test::Exception; + +use Data::Dumper; +our %opt; +BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } +use constant DEBUG => (exists $opt{d} ? 1 : 0); +use constant TRACE => (exists $opt{t} ? 1 : 0); + +use FindBin qw/$Bin/; + +my $file = "$Bin/data/mysql/sqlfxml-producer-basic.sql"; + + +# 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."; +} +use Test::Differences; +plan tests => 6; + +use SQL::Translator; +use SQL::Translator::Producer::SqlfXML; + +my ($obj,$ans,$xml); + +# +# emit_empty_tags => 0 +# + +$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 + + + + +EOXML + +$obj = SQL::Translator->new( + debug => DEBUG, + trace => TRACE, + show_warnings => 1, + add_drop_table => 1, + from => "MySQL", + to => "SqlfXML", +); +lives_ok { $xml = $obj->translate($file); } "Translate 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"; + +# +# emit_empty_tags => 1 +# + +$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 + + + + +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 ;-) + +#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"); diff --git a/t/data/mysql/sqlfxml-producer-basic.sql b/t/data/mysql/sqlfxml-producer-basic.sql new file mode 100644 index 0000000..a5b0874 --- /dev/null +++ b/t/data/mysql/sqlfxml-producer-basic.sql @@ -0,0 +1,19 @@ +-- +-- Created by SQL::Translator::Producer::MySQL +-- Created on Thu Aug 7 16:28:01 2003 +-- +-- SET foreign_key_checks=0; + +-- +-- Table: Basic +-- +CREATE TABLE Basic ( + id integer(10) NOT NULL auto_increment + ,title varchar(100) NOT NULL DEFAULT 'hello' + ,description text DEFAULT '' + ,email varchar(255) + ,INDEX titleindex (title) + ,PRIMARY KEY (id) + ,UNIQUE (email) +); +