Added writing of field.extra
Mark Addison [Thu, 8 Jul 2004 23:39:38 +0000 (23:39 +0000)]
lib/SQL/Translator/Producer/XML/SQLFairy.pm
t/17sqlfxml-producer.t

index 2b4834d..dc8ed87 100644 (file)
@@ -1,7 +1,7 @@
 package SQL::Translator::Producer::XML::SQLFairy;
 
 # -------------------------------------------------------------------
-# $Id: SQLFairy.pm,v 1.14 2004-07-08 20:37:26 grommit Exp $
+# $Id: SQLFairy.pm,v 1.15 2004-07-08 23:39:38 grommit Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
 #                    darren chamberlain <darren@cpan.org>,
@@ -62,6 +62,10 @@ get mapped to a comma seperated list of values in the attribute.
 Child objects, such as a tables fields, get mapped to child tags wrapped in a
 set of container tags using the plural of their contained classes name.
 
+L<SQL::Translator::Schema::Field>'s extra attribute (a hash of arbitary data) is
+mapped to a tag called extra, with the hash of data as attributes, sorted into
+alphabetical order.
+
 e.g.
 
     <schema name="" database=""
@@ -70,14 +74,16 @@ e.g.
       <table name="Story" order="1">
 
         <fields>
-          <field name="created" data_type="datetime" size="0"
-            is_nullable="1" is_auto_increment="0" is_primary_key="0"
-            is_foreign_key="0" order="1">
-            <comments></comments>
-          </field>
           <field name="id" data_type="BIGINT" size="20"
             is_nullable="0" is_auto_increment="1" is_primary_key="1"
             is_foreign_key="0" order="3">
+            <extra ZEROFILL="1" />
+            <comments></comments>
+          </field>
+          <field name="created" data_type="datetime" size="0"
+            is_nullable="1" is_auto_increment="0" is_primary_key="0"
+            is_foreign_key="0" order="1">
+            <extra />
             <comments></comments>
           </field>
           ...
@@ -127,6 +133,16 @@ e.g.
  <!-- prefix='foo' -->
  <foo:field name="foo" />
 
+=item newlines
+
+If true (the default) inserts newlines around the XML, otherwise the schema is
+written on one line.
+
+=item indent
+
+When using newlines the number of whitespace characters to use as the indent.
+Default is 2, set to 0 to turn off indenting.
+
 =back
 
 =head1 LEGACY FORMAT
@@ -147,7 +163,7 @@ To convert your old format files simply pass them through the translator;
 
 use strict;
 use vars qw[ $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/;
 
 use Exporter;
 use base qw(Exporter);
@@ -209,7 +225,7 @@ sub produce {
                 tag     =>"field",
                 end_tag => 1,
                 methods =>[qw/name data_type size is_nullable default_value
-                    is_auto_increment is_primary_key is_foreign_key comments order
+                    is_auto_increment is_primary_key is_foreign_key extra comments order
                 /],
             );
         }
@@ -305,8 +321,10 @@ sub xml_obj {
     my @tags;
     my @attr;
     foreach ( grep { defined $obj->$_ } @meths ) {
-        my $what = m/^sql|comments|action$/ ? \@tags : \@attr;
-        my $val = $obj->$_;
+        my $what = m/^(sql|comments|action|extra)$/ ? \@tags : \@attr;
+        my $val = $_ eq 'extra'
+            ? { $obj->$_ }
+            : $obj->$_;
         $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
         push @$what, $_ => $val;
     };
@@ -315,7 +333,13 @@ sub xml_obj {
         ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
         : $xml->startTag( [ $Namespace => $tag ], @attr );
     while ( my ($name,$val) = splice @tags,0,2 ) {
-        $xml->dataElement( [ $Namespace => $name ], $val );
+        if ( ref $val eq 'HASH' ) {
+             $xml->emptyTag( [ $Namespace => $name ],
+                 map { ($_, $val->{$_}) } sort keys %$val );
+        }
+        else {
+            $xml->dataElement( [ $Namespace => $name ], $val );
+        }
     }
     $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag;
 }
index bfe808c..3f39727 100644 (file)
@@ -30,7 +30,7 @@ local $SIG{__WARN__} = sub {
 #=============================================================================
 
 BEGIN {
-    maybe_plan(12,
+    maybe_plan(15,
         'XML::Writer',
         'Test::Differences',
         'SQL::Translator::Producer::XML::SQLFairy');
@@ -51,15 +51,19 @@ $ans = <<EOXML;
   <table name="Basic" order="1">
     <fields>
       <field name="id" data_type="integer" size="10" is_nullable="0" is_auto_increment="1" is_primary_key="1" is_foreign_key="0" order="1">
+        <extra />
         <comments>comment on id field</comments>
       </field>
       <field name="title" data_type="varchar" size="100" is_nullable="0" default_value="hello" is_auto_increment="0" is_primary_key="0" is_foreign_key="0" order="2">
+        <extra />
         <comments></comments>
       </field>
       <field name="description" data_type="text" size="65535" is_nullable="1" default_value="" is_auto_increment="0" is_primary_key="0" is_foreign_key="0" order="3">
+        <extra />
         <comments></comments>
       </field>
       <field name="email" data_type="varchar" size="255" is_nullable="1" is_auto_increment="0" is_primary_key="0" is_foreign_key="0" order="4">
+        <extra />
         <comments></comments>
       </field>
     </fields>
@@ -229,3 +233,51 @@ EOXML
     $xml =~ s/^([^\n]*\n){7}//m; 
     eq_or_diff $xml, $ans                       ,"XML looks right";
 } # end Procedure
+
+#
+# Field.extra
+#
+{
+my ($obj,$ans,$xml);
+
+$ans = <<EOXML;
+<schema name="" database="" xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml">
+  <table name="Basic" order="2">
+    <fields>
+      <field name="foo" data_type="integer" size="10" is_nullable="1" is_auto_increment="0" is_primary_key="0" is_foreign_key="0" order="5">
+        <extra ZEROFILL="1" />
+        <comments></comments>
+      </field>
+    </fields>
+    <indices></indices>
+    <constraints></constraints>
+  </table>
+</schema>
+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