Made some changes suggested by Michael Slattery to fix table level comments. Also...
Ben Faga [Tue, 5 Jul 2005 16:20:43 +0000 (16:20 +0000)]
His remarks follow:

Table level comments weren't populating.  The empty tag is generated in XML, but not populated.  $table->comments() doesn't have a get_comments method, so that explains my if/else around $meth

Right now it produces 'comment' data elements with no attributes in the 'comments' tag.  If this is a bad idea please let me know.

lib/SQL/Translator/Parser/XML/SQLFairy.pm
lib/SQL/Translator/Producer/PostgreSQL.pm
lib/SQL/Translator/Producer/SQLite.pm
lib/SQL/Translator/Producer/XML/SQLFairy.pm

index 67a9bfc..0c542bd 100644 (file)
@@ -1,7 +1,7 @@
 package SQL::Translator::Parser::XML::SQLFairy;
 
 # -------------------------------------------------------------------
-# $Id: SQLFairy.pm,v 1.14 2005-06-28 16:39:41 mwz444 Exp $
+# $Id: SQLFairy.pm,v 1.15 2005-07-05 16:20:42 mwz444 Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
 #
@@ -100,7 +100,7 @@ To convert your old format files simply pass them through the translator :)
 use strict;
 
 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
@@ -201,6 +201,16 @@ sub parse {
             $table->add_index( %data ) or die $table->error;
         }
 
+        
+        #
+        # Comments
+        #
+        @nodes = $xp->findnodes('sqlf:comments/sqlf:comment',$tblnode);
+        foreach (@nodes) {
+            my $data = $_->string_value;
+            $table->comments( $data );
+        }
+
     } # tables loop
 
     #
index 458b9ae..f97669c 100644 (file)
@@ -1,7 +1,7 @@
 package SQL::Translator::Producer::PostgreSQL;
 
 # -------------------------------------------------------------------
-# $Id: PostgreSQL.pm,v 1.22 2004-02-09 23:02:15 kycl4rk Exp $
+# $Id: PostgreSQL.pm,v 1.23 2005-07-05 16:20:43 mwz444 Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2002-4 SQLFairy Authors
 #
@@ -38,7 +38,7 @@ producer.
 
 use strict;
 use vars qw[ $DEBUG $WARN $VERSION ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.22 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.23 $ =~ /(\d+)\.(\d+)/;
 $DEBUG = 1 unless defined $DEBUG;
 
 use SQL::Translator::Schema::Constants;
@@ -184,10 +184,18 @@ sub produce {
         $table_name       = mk_name( $table_name, '', undef, 1 );
         my $table_name_ur = unreserve($table_name);
 
+print STDERR "$table_name table_name\n";
         my ( @comments, @field_defs, @sequence_defs, @constraint_defs );
 
         push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
 
+        if ( $table->comments and !$no_comments ){
+            my $c = "-- Comments: \n-- ";
+            $c .= join "\n-- ",  $table->comments;
+            $c .= "\n--";
+            push @comments, $c;
+        }
+
         #
         # Fields
         #
@@ -197,7 +205,11 @@ sub produce {
                 $field->name, '', \%field_name_scope, 1 
             );
             my $field_name_ur = unreserve( $field_name, $table_name );
-            my $field_def     = qq["$field_name_ur"];
+            my $field_comments = $field->comments 
+                ? "-- " . $field->comments . "\n  " 
+                : '';
+
+            my $field_def     = $field_comments.qq["$field_name_ur"];
 
             #
             # Datatype
index 5a27a30..2029efe 100644 (file)
@@ -1,7 +1,7 @@
 package SQL::Translator::Producer::SQLite;
 
 # -------------------------------------------------------------------
-# $Id: SQLite.pm,v 1.12 2005-06-13 18:23:10 mwz444 Exp $
+# $Id: SQLite.pm,v 1.13 2005-07-05 16:20:43 mwz444 Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2002-4 SQLFairy Authors
 #
@@ -44,7 +44,7 @@ use SQL::Translator::Utils qw(debug header_comment);
 
 use vars qw[ $VERSION $DEBUG $WARN ];
 
-$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/;
 $DEBUG = 0 unless defined $DEBUG;
 $WARN = 0 unless defined $WARN;
 
@@ -82,6 +82,15 @@ sub produce {
         $create .= "CREATE TABLE $table_name (\n";
 
         #
+        # Comments
+        #
+        if ( $table->comments and !$no_comments ){
+             $create .= "-- Comments: \n-- ";
+             $create .= join "\n-- ",  $table->comments;
+             $create .= "\n--\n\n";
+        }
+
+        #
         # How many fields in PK?
         #
         my $pk        = $table->primary_key;
@@ -94,7 +103,11 @@ sub produce {
         for my $field ( @fields ) {
             my $field_name = $field->name;
             debug("PKG: Looking at field '$field_name'\n");
-            my $field_def = $field_name;
+            my $field_comments = $field->comments 
+                ? "-- " . $field->comments . "\n  " 
+                : '';
+
+            my $field_def = $field_comments.$field_name;
 
             # data type and size
             my $size      = $field->size;
index 8871a10..66a91d7 100644 (file)
@@ -1,7 +1,7 @@
 package SQL::Translator::Producer::XML::SQLFairy;
 
 # -------------------------------------------------------------------
-# $Id: SQLFairy.pm,v 1.19 2004-11-05 16:37:00 grommit Exp $
+# $Id: SQLFairy.pm,v 1.20 2005-07-05 16:20:43 mwz444 Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
 #                    darren chamberlain <darren@cpan.org>,
@@ -165,7 +165,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.19 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/;
 
 use Exporter;
 use base qw(Exporter);
@@ -260,6 +260,17 @@ sub produce {
             /],
         );
 
+        #
+        # Comments
+        #
+        xml_obj_children( $xml, $table,
+            tag   => 'comment',
+            collection_tag => "comments",
+            methods => [qw/
+                comments
+            /],
+        );
+
         $xml->endTag( [ $Namespace => 'table' ] );
     }
     $xml->endTag( [ $Namespace => 'tables' ] );
@@ -309,17 +320,28 @@ sub xml_obj_children {
     my ($name,$collection_name,$methods)
         = @args{qw/tag collection_tag methods/};
     $collection_name ||= "${name}s";
-    my $meth = "get_$collection_name";
+
+    my $meth;
+    if ( $collection_name eq 'comments' ) {
+      $meth = 'comments';
+    } else {
+      $meth = "get_$collection_name";
+    }
 
     my @kids = $parent->$meth;
     #@kids || return;
     $xml->startTag( [ $Namespace => $collection_name ] );
+
     for my $obj ( @kids ) {
-        xml_obj($xml, $obj,
-            tag     => "$name",
-            end_tag => 1,
-            methods => $methods,
-        );
+        if ( $collection_name eq 'comments' ){
+            $xml->dataElement( [ $Namespace => 'comment' ], $obj );
+        } else {
+            xml_obj($xml, $obj,
+                tag     => "$name",
+                end_tag => 1,
+                methods => $methods,
+            );
+        }
     }
     $xml->endTag( [ $Namespace => $collection_name ] );
 }