package SQL::Translator::Producer::XML::SQLFairy;
# -------------------------------------------------------------------
-# $Id: SQLFairy.pm,v 1.18 2004-08-19 20:41:32 grommit Exp $
-# -------------------------------------------------------------------
# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
# darren chamberlain <darren@cpan.org>,
# Chris Mungall <cjm@fruitfly.org>,
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
+An objects'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.
use strict;
use vars qw[ $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/;
+$VERSION = '1.59';
use Exporter;
use base qw(Exporter);
$xml->xmlDecl('UTF-8');
$xml->comment(header_comment('', ''));
xml_obj($xml, $schema,
- tag => "schema", methods => [qw/name database/], end_tag => 0 );
+ tag => "schema", methods => [qw/name database extra/], end_tag => 0 );
#
# Table
debug "Table:",$table->name;
xml_obj($xml, $table,
tag => "table",
- methods => [qw/name order/],
+ methods => [qw/name order extra/],
end_tag => 0
);
xml_obj_children( $xml, $table,
tag => 'index',
collection_tag => "indices",
- methods => [qw/name type fields options/],
+ methods => [qw/name type fields options extra/],
);
#
methods => [qw/
name type fields reference_table reference_fields
on_delete on_update match_type expression options deferrable
+ extra
+ /],
+ );
+
+ #
+ # Comments
+ #
+ xml_obj_children( $xml, $table,
+ tag => 'comment',
+ collection_tag => "comments",
+ methods => [qw/
+ comments
/],
);
#
xml_obj_children( $xml, $schema,
tag => 'view',
- methods => [qw/name sql fields order/],
+ methods => [qw/name sql fields order extra/],
);
#
#
xml_obj_children( $xml, $schema,
tag => 'trigger',
- methods => [qw/name database_event action on_table perform_action_when
- fields order/],
+ methods => [qw/name database_events action on_table perform_action_when
+ fields order extra/],
);
#
#
xml_obj_children( $xml, $schema,
tag => 'procedure',
- methods => [qw/name sql parameters owner comments order/],
+ methods => [qw/name sql parameters owner comments order extra/],
);
$xml->endTag([ $Namespace => 'schema' ]);
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 ] );
}