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 (file)
--- 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 <kclark@cpan.org>,
 #                    darren chamberlain <darren@cpan.org>,
@@ -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'" : "<UNDEF>");
+        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 E<lt>kclark@cpan.orgE<gt>, darren chamberlain E<lt>darren@cpan.orgE<gt>
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>, 
+darren chamberlain E<lt>darren@cpan.orgE<gt>, 
+mark addison E<lt>mark.addison@itn.co.ukE<gt>, 
 
 =head1 SEE ALSO
 

diff --git a/t/17sqlfxml-producer.t b/t/17sqlfxml-producer.t
new file mode 100644 (file)
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 = <<EOXML;
+<sqlt:schema xmlns:sqlt="http://sqlfairy.sourceforge.net/sqlfairy.xml">
+  <sqlt:table>
+    <sqlt:name>Basic</sqlt:name>
+    <sqlt:order>1</sqlt:order>
+    <sqlt:fields>
+      <sqlt:field>
+        <sqlt:name>id</sqlt:name>
+        <sqlt:data_type>integer</sqlt:data_type>
+        <sqlt:is_auto_increment>1</sqlt:is_auto_increment>
+        <sqlt:is_primary_key>1</sqlt:is_primary_key>
+        <sqlt:is_nullable>0</sqlt:is_nullable>
+        <sqlt:is_foreign_key>0</sqlt:is_foreign_key>
+        <sqlt:order>1</sqlt:order>
+        <sqlt:size>10</sqlt:size>
+      </sqlt:field>
+      <sqlt:field>
+        <sqlt:name>title</sqlt:name>
+        <sqlt:data_type>varchar</sqlt:data_type>
+        <sqlt:default_value>hello</sqlt:default_value>
+        <sqlt:is_auto_increment>0</sqlt:is_auto_increment>
+        <sqlt:is_primary_key>0</sqlt:is_primary_key>
+        <sqlt:is_nullable>0</sqlt:is_nullable>
+        <sqlt:is_foreign_key>0</sqlt:is_foreign_key>
+        <sqlt:order>2</sqlt:order>
+        <sqlt:size>100</sqlt:size>
+      </sqlt:field>
+      <sqlt:field>
+        <sqlt:name>description</sqlt:name>
+        <sqlt:data_type>text</sqlt:data_type>
+        <sqlt:default_value></sqlt:default_value>
+        <sqlt:is_auto_increment>0</sqlt:is_auto_increment>
+        <sqlt:is_primary_key>0</sqlt:is_primary_key>
+        <sqlt:is_nullable>1</sqlt:is_nullable>
+        <sqlt:is_foreign_key>0</sqlt:is_foreign_key>
+        <sqlt:order>3</sqlt:order>
+        <sqlt:size>0</sqlt:size>
+      </sqlt:field>
+      <sqlt:field>
+        <sqlt:name>email</sqlt:name>
+        <sqlt:data_type>varchar</sqlt:data_type>
+        <sqlt:is_auto_increment>0</sqlt:is_auto_increment>
+        <sqlt:is_primary_key>0</sqlt:is_primary_key>
+        <sqlt:is_nullable>1</sqlt:is_nullable>
+        <sqlt:is_foreign_key>0</sqlt:is_foreign_key>
+        <sqlt:order>4</sqlt:order>
+        <sqlt:size>255</sqlt:size>
+      </sqlt:field>
+    </sqlt:fields>
+    <sqlt:indices>
+      <sqlt:index>
+        <sqlt:fields>title</sqlt:fields>
+        <sqlt:name>titleindex</sqlt:name>
+        <sqlt:options></sqlt:options>
+        <sqlt:type>NORMAL</sqlt:type>
+      </sqlt:index>
+    </sqlt:indices>
+    <sqlt:constraints>
+      <sqlt:constraint>
+        <sqlt:deferrable>1</sqlt:deferrable>
+        <sqlt:expression></sqlt:expression>
+        <sqlt:fields>id</sqlt:fields>
+        <sqlt:match_type></sqlt:match_type>
+        <sqlt:name></sqlt:name>
+        <sqlt:options></sqlt:options>
+        <sqlt:on_delete></sqlt:on_delete>
+        <sqlt:on_update></sqlt:on_update>
+        <sqlt:reference_table></sqlt:reference_table>
+        <sqlt:type>PRIMARY KEY</sqlt:type>
+      </sqlt:constraint>
+      <sqlt:constraint>
+        <sqlt:deferrable>1</sqlt:deferrable>
+        <sqlt:expression></sqlt:expression>
+        <sqlt:fields>email</sqlt:fields>
+        <sqlt:match_type></sqlt:match_type>
+        <sqlt:name></sqlt:name>
+        <sqlt:options></sqlt:options>
+        <sqlt:on_delete></sqlt:on_delete>
+        <sqlt:on_update></sqlt:on_update>
+        <sqlt:reference_table></sqlt:reference_table>
+        <sqlt:type>UNIQUE</sqlt:type>
+      </sqlt:constraint>
+    </sqlt:constraints>
+  </sqlt:table>
+</sqlt:schema>
+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 = <<EOXML;
+<sqlt:schema xmlns:sqlt="http://sqlfairy.sourceforge.net/sqlfairy.xml">
+  <sqlt:table>
+    <sqlt:name>Basic</sqlt:name>
+    <sqlt:order>2</sqlt:order>
+    <sqlt:fields>
+      <sqlt:field>
+        <sqlt:name>id</sqlt:name>
+        <sqlt:data_type>integer</sqlt:data_type>
+        <sqlt:default_value></sqlt:default_value>
+        <sqlt:is_auto_increment>1</sqlt:is_auto_increment>
+        <sqlt:is_primary_key>1</sqlt:is_primary_key>
+        <sqlt:is_nullable>0</sqlt:is_nullable>
+        <sqlt:is_foreign_key>0</sqlt:is_foreign_key>
+        <sqlt:order>5</sqlt:order>
+        <sqlt:size>10</sqlt:size>
+      </sqlt:field>
+      <sqlt:field>
+        <sqlt:name>title</sqlt:name>
+        <sqlt:data_type>varchar</sqlt:data_type>
+        <sqlt:default_value>hello</sqlt:default_value>
+        <sqlt:is_auto_increment>0</sqlt:is_auto_increment>
+        <sqlt:is_primary_key>0</sqlt:is_primary_key>
+        <sqlt:is_nullable>0</sqlt:is_nullable>
+        <sqlt:is_foreign_key>0</sqlt:is_foreign_key>
+        <sqlt:order>6</sqlt:order>
+        <sqlt:size>100</sqlt:size>
+      </sqlt:field>
+      <sqlt:field>
+        <sqlt:name>description</sqlt:name>
+        <sqlt:data_type>text</sqlt:data_type>
+        <sqlt:default_value></sqlt:default_value>
+        <sqlt:is_auto_increment>0</sqlt:is_auto_increment>
+        <sqlt:is_primary_key>0</sqlt:is_primary_key>
+        <sqlt:is_nullable>1</sqlt:is_nullable>
+        <sqlt:is_foreign_key>0</sqlt:is_foreign_key>
+        <sqlt:order>7</sqlt:order>
+        <sqlt:size>0</sqlt:size>
+      </sqlt:field>
+      <sqlt:field>
+        <sqlt:name>email</sqlt:name>
+        <sqlt:data_type>varchar</sqlt:data_type>
+        <sqlt:default_value></sqlt:default_value>
+        <sqlt:is_auto_increment>0</sqlt:is_auto_increment>
+        <sqlt:is_primary_key>0</sqlt:is_primary_key>
+        <sqlt:is_nullable>1</sqlt:is_nullable>
+        <sqlt:is_foreign_key>0</sqlt:is_foreign_key>
+        <sqlt:order>8</sqlt:order>
+        <sqlt:size>255</sqlt:size>
+      </sqlt:field>
+    </sqlt:fields>
+    <sqlt:indices>
+      <sqlt:index>
+        <sqlt:fields>title</sqlt:fields>
+        <sqlt:name>titleindex</sqlt:name>
+        <sqlt:options></sqlt:options>
+        <sqlt:type>NORMAL</sqlt:type>
+      </sqlt:index>
+    </sqlt:indices>
+    <sqlt:constraints>
+      <sqlt:constraint>
+        <sqlt:deferrable>1</sqlt:deferrable>
+        <sqlt:expression></sqlt:expression>
+        <sqlt:fields>id</sqlt:fields>
+        <sqlt:match_type></sqlt:match_type>
+        <sqlt:name></sqlt:name>
+        <sqlt:options></sqlt:options>
+        <sqlt:on_delete></sqlt:on_delete>
+        <sqlt:on_update></sqlt:on_update>
+        <sqlt:reference_fields></sqlt:reference_fields>
+        <sqlt:reference_table></sqlt:reference_table>
+        <sqlt:type>PRIMARY KEY</sqlt:type>
+      </sqlt:constraint>
+      <sqlt:constraint>
+        <sqlt:deferrable>1</sqlt:deferrable>
+        <sqlt:expression></sqlt:expression>
+        <sqlt:fields>email</sqlt:fields>
+        <sqlt:match_type></sqlt:match_type>
+        <sqlt:name></sqlt:name>
+        <sqlt:options></sqlt:options>
+        <sqlt:on_delete></sqlt:on_delete>
+        <sqlt:on_update></sqlt:on_update>
+        <sqlt:reference_fields></sqlt:reference_fields>
+        <sqlt:reference_table></sqlt:reference_table>
+        <sqlt:type>UNIQUE</sqlt:type>
+      </sqlt:constraint>
+    </sqlt:constraints>
+  </sqlt:table>
+</sqlt:schema>
+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 (file)
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)
+);
+