[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / XML / SQLFairy.pm

package SQL::Translator::Producer::XML::SQLFairy;

=pod

=head1 NAME

SQL::Translator::Producer::XML::SQLFairy - SQLFairy's default XML format

=head1 SYNOPSIS

  use SQL::Translator;

  my $t              = SQL::Translator->new(
      from           => 'MySQL',
      to             => 'XML-SQLFairy',
      filename       => 'schema.sql',
      show_warnings  => 1,
  );

  print $t->translate;

=head1 DESCRIPTION

Creates XML output of a schema, in the flavor of XML used natively by the
SQLFairy project (L<SQL::Translator>). This format is detailed here.

The XML lives in the C<http://sqlfairy.sourceforge.net/sqlfairy.xml> namespace.
With a root element of <schema>.

Objects in the schema are mapped to tags of the same name as the objects class
(all lowercase).

The attributes of the objects (e.g. $field->name) are mapped to attributes of
the tag, except for sql, comments and action, which get mapped to child data
elements.

List valued attributes (such as the list of fields in an index)
get mapped to comma separated lists 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.

An objects' extra attribute (a hash of arbitrary data) is
mapped to a tag called extra, with the hash of data as attributes, sorted into
alphabetical order.

e.g.

    <schema name="" database=""
      xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml">

      <tables>
        <table name="Story" order="1">
          <fields>
            <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>
            ...
          </fields>
          <indices>
            <index name="foobar" type="NORMAL" fields="foo,bar" options="" />
          </indices>
        </table>
      </tables>

      <views>
        <view name="email_list" fields="email" order="1">
          <sql>SELECT email FROM Basic WHERE email IS NOT NULL</sql>
        </view>
      </views>

    </schema>

To see a complete example of the XML translate one of your schema :)

  $ sqlt -f MySQL -t XML-SQLFairy schema.sql

=head1 ARGS

=over 4

=item add_prefix

Set to true to use the default namespace prefix of 'sqlf', instead of using
the default namespace for
C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>

e.g.

 <!-- add_prefix=0 -->
 <field name="foo" />

 <!-- add_prefix=1 -->
 <sqlf:field name="foo" />

=item prefix

Set to the namespace prefix you want to use for the
C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>

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

The previous version of the SQLFairy XML allowed the attributes of the
schema objects to be written as either xml attributes or as data elements, in
any combination. The old producer could produce attribute only or data element
only versions. While this allowed for lots of flexibility in writing the XML
the result is a great many possible XML formats, not so good for DTD writing,
XPathing etc! So we have moved to a fixed version described above.

This version of the producer will now only produce the new style XML.
To convert your old format files simply pass them through the translator :)

 $ sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml

=cut

use strict;
use warnings;
our @EXPORT_OK;
our $VERSION = '1.59';

use Exporter;
use base qw(Exporter);
@EXPORT_OK = qw(produce);

use SQL::Translator::Utils qw(header_comment debug);
BEGIN {
    # Will someone fix XML::Writer already?
    local $^W = 0;
    require XML::Writer;
    import XML::Writer;
}

# Which schema object attributes (methods) to write as xml elements rather than
# as attributes. e.g. <comments>blah, blah...</comments>
my @MAP_AS_ELEMENTS = qw/sql comments action extra/;


my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
my $Name      = 'sqlf';
my $PArgs     = {};
my $no_comments;

sub produce {
    my $translator  = shift;
    my $schema      = $translator->schema;
    $no_comments    = $translator->no_comments;
    $PArgs          = $translator->producer_args;
    my $newlines    = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1;
    my $indent      = defined $PArgs->{indent}   ? $PArgs->{indent}   : 2;

    # Setup the XML::Writer and set the namespace
    my $io;
    my $prefix = "";
    $prefix    = $Name            if $PArgs->{add_prefix};
    $prefix    = $PArgs->{prefix} if $PArgs->{prefix};
    my $xml         = XML::Writer->new(
        OUTPUT      => \$io,
        NAMESPACES  => 1,
        PREFIX_MAP  => { $Namespace => $prefix },
        DATA_MODE   => $newlines,
        DATA_INDENT => $indent,
    );

    # Start the document
    $xml->xmlDecl('UTF-8');

    $xml->comment(header_comment('', ''))
      unless $no_comments;

    xml_obj($xml, $schema,
        tag => "schema", methods => [qw/name database extra/], end_tag => 0 );

    #
    # Table
    #
    $xml->startTag( [ $Namespace => "tables" ] );
    for my $table ( $schema->get_tables ) {
        debug "Table:",$table->name;
        xml_obj($xml, $table,
             tag => "table",
             methods => [qw/name order extra/],
             end_tag => 0
         );

        #
        # Fields
        #
        xml_obj_children( $xml, $table,
            tag   => 'field',
            methods =>[qw/
                name data_type size is_nullable default_value is_auto_increment
                is_primary_key is_foreign_key extra comments order
            /],
        );

        #
        # Indices
        #
        xml_obj_children( $xml, $table,
            tag   => 'index',
            collection_tag => "indices",
            methods => [qw/name type fields options extra/],
        );

        #
        # Constraints
        #
        xml_obj_children( $xml, $table,
            tag   => 'constraint',
            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->endTag( [ $Namespace => 'table' ] );
    }
    $xml->endTag( [ $Namespace => 'tables' ] );

    #
    # Views
    #
    xml_obj_children( $xml, $schema,
        tag   => 'view',
        methods => [qw/name sql fields order extra/],
    );

    #
    # Tiggers
    #
    xml_obj_children( $xml, $schema,
        tag    => 'trigger',
        methods => [qw/name database_events action on_table perform_action_when
            fields order extra scope/],
    );

    #
    # Procedures
    #
    xml_obj_children( $xml, $schema,
        tag   => 'procedure',
        methods => [qw/name sql parameters owner comments order extra/],
    );

    $xml->endTag([ $Namespace => 'schema' ]);
    $xml->end;

    return $io;
}


#
# Takes and XML::Write object, Schema::* parent object, the tag name,
# the collection name and a list of methods (of the children) to write as XML.
# The collection name defaults to the name with an s on the end and is used to
# work out the method to get the children with. eg a name of 'foo' gives a
# collection of foos and gets the members using ->get_foos.
#
sub xml_obj_children {
    my ($xml,$parent) = (shift,shift);
    my %args = @_;
    my ($name,$collection_name,$methods)
        = @args{qw/tag collection_tag methods/};
    $collection_name ||= "${name}s";

    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 ) {
        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 ] );
}

#
# Takes an XML::Writer, Schema::* object and list of method names
# and writes the object out as XML. All methods values are written as attributes
# except for the methods listed in @MAP_AS_ELEMENTS which get written as child
# data elements.
#
# The attributes/tags are written in the same order as the method names are
# passed.
#
# TODO
# - Should the Namespace be passed in instead of global? Pass in the same
#   as Writer ie [ NS => TAGNAME ]
#
my $elements_re = join("|", @MAP_AS_ELEMENTS);
$elements_re = qr/^($elements_re)$/;
sub xml_obj {
    my ($xml, $obj, %args) = @_;
    my $tag                = $args{'tag'}              || '';
    my $end_tag            = $args{'end_tag'}          || '';
    my @meths              = @{ $args{'methods'} };
    my $empty_tag          = 0;

    # Use array to ensure consistent (ie not hash) ordering of attribs
    # The order comes from the meths list passed in.
    my @tags;
    my @attr;
    foreach ( grep { defined $obj->$_ } @meths ) {
        my $what = m/$elements_re/ ? \@tags : \@attr;
        my $val = $_ eq 'extra'
            ? { $obj->$_ }
            : $obj->$_;
        $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
        push @$what, $_ => $val;
    };
    my $child_tags = @tags;
    $end_tag && !$child_tags
        ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
        : $xml->startTag( [ $Namespace => $tag ], @attr );
    while ( my ($name,$val) = splice @tags,0,2 ) {
        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;
}

1;

# -------------------------------------------------------------------
# The eyes of fire, the nostrils of air,
# The mouth of water, the beard of earth.
# William Blake
# -------------------------------------------------------------------

=pod

=head1 AUTHORS

Ken Youens-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

C<perl(1)>, L<SQL::Translator>, L<SQL::Translator::Parser::XML::SQLFairy>,
L<SQL::Translator::Schema>, L<XML::Writer>.

=cut
Commit	Line	Data
0a689100	1	package SQL::Translator::Producer::XML::SQLFairy;
0a689100	2
0a689100	3	=pod
	4
	5	=head1 NAME
	6
a7d50b44	7	SQL::Translator::Producer::XML::SQLFairy - SQLFairy's default XML format
0a689100	8
	9	=head1 SYNOPSIS
	10
	11	use SQL::Translator;
	12
	13	my $t = SQL::Translator->new(
	14	from => 'MySQL',
a7d50b44	15	to => 'XML-SQLFairy',
0a689100	16	filename => 'schema.sql',
0a689100	17	show_warnings => 1,
0a689100	18	);
	19
	20	print $t->translate;
	21
b89a67a0	22	=head1 DESCRIPTION
0a689100	23
91f28468	24	Creates XML output of a schema, in the flavor of XML used natively by the
91f28468	25	SQLFairy project (L<SQL::Translator>). This format is detailed here.
0a689100	26
91f28468	27	The XML lives in the C<http://sqlfairy.sourceforge.net/sqlfairy.xml> namespace.
b89a67a0	28	With a root element of <schema>.
0a689100	29
91f28468	30	Objects in the schema are mapped to tags of the same name as the objects class
91f28468	31	(all lowercase).
0a689100	32
b89a67a0	33	The attributes of the objects (e.g. $field->name) are mapped to attributes of
	34	the tag, except for sql, comments and action, which get mapped to child data
	35	elements.
0a689100	36
b89a67a0	37	List valued attributes (such as the list of fields in an index)
10f70490	38	get mapped to comma separated lists of values in the attribute.
0a689100	39
b89a67a0	40	Child objects, such as a tables fields, get mapped to child tags wrapped in a
b89a67a0	41	set of container tags using the plural of their contained classes name.
0a689100	42
10f70490	43	An objects' extra attribute (a hash of arbitrary data) is
e0a0c3e1	44	mapped to a tag called extra, with the hash of data as attributes, sorted into
	45	alphabetical order.
	46
b89a67a0	47	e.g.
0a689100	48
b89a67a0	49	<schema name="" database=""
b89a67a0	50	xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml">
0a689100	51
91f28468	52	<tables>
	53	<table name="Story" order="1">
	54	<fields>
	55	<field name="id" data_type="BIGINT" size="20"
	56	is_nullable="0" is_auto_increment="1" is_primary_key="1"
	57	is_foreign_key="0" order="3">
	58	<extra ZEROFILL="1" />
	59	<comments></comments>
	60	</field>
	61	<field name="created" data_type="datetime" size="0"
	62	is_nullable="1" is_auto_increment="0" is_primary_key="0"
	63	is_foreign_key="0" order="1">
	64	<extra />
	65	<comments></comments>
	66	</field>
	67	...
	68	</fields>
	69	<indices>
	70	<index name="foobar" type="NORMAL" fields="foo,bar" options="" />
	71	</indices>
	72	</table>
	73	</tables>
	74
	75	<views>
	76	<view name="email_list" fields="email" order="1">
	77	<sql>SELECT email FROM Basic WHERE email IS NOT NULL</sql>
	78	</view>
	79	</views>
b89a67a0	80
	81	</schema>
	82
	83	To see a complete example of the XML translate one of your schema :)
	84
	85	$ sqlt -f MySQL -t XML-SQLFairy schema.sql
	86
	87	=head1 ARGS
0a689100	88
983ed646	89	=over 4
	90
	91	=item add_prefix
	92
	93	Set to true to use the default namespace prefix of 'sqlf', instead of using
	94	the default namespace for
	95	C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
	96
	97	e.g.
	98
	99	<!-- add_prefix=0 -->
	100	<field name="foo" />
	101
	102	<!-- add_prefix=1 -->
	103	<sqlf:field name="foo" />
	104
	105	=item prefix
	106
	107	Set to the namespace prefix you want to use for the
	108	C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
	109
	110	e.g.
	111
	112	<!-- prefix='foo' -->
	113	<foo:field name="foo" />
	114
e0a0c3e1	115	=item newlines
	116
	117	If true (the default) inserts newlines around the XML, otherwise the schema is
	118	written on one line.
	119
	120	=item indent
	121
	122	When using newlines the number of whitespace characters to use as the indent.
	123	Default is 2, set to 0 to turn off indenting.
	124
983ed646	125	=back
0a689100	126
4a268a6c	127	=head1 LEGACY FORMAT
4a268a6c	128
a37acd3a	129	The previous version of the SQLFairy XML allowed the attributes of the
4a268a6c	130	schema objects to be written as either xml attributes or as data elements, in
	131	any combination. The old producer could produce attribute only or data element
	132	only versions. While this allowed for lots of flexibility in writing the XML
	133	the result is a great many possible XML formats, not so good for DTD writing,
	134	XPathing etc! So we have moved to a fixed version described above.
	135
	136	This version of the producer will now only produce the new style XML.
91f28468	137	To convert your old format files simply pass them through the translator :)
4a268a6c	138
91f28468	139	$ sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml
4a268a6c	140
0a689100	141	=cut
	142
	143	use strict;
f27f9229	144	use warnings;
0c04c5a2	145	our @EXPORT_OK;
0c04c5a2	146	our $VERSION = '1.59';
0a689100	147
	148	use Exporter;
	149	use base qw(Exporter);
	150	@EXPORT_OK = qw(produce);
	151
0a689100	152	use SQL::Translator::Utils qw(header_comment debug);
f135f8f9	153	BEGIN {
	154	# Will someone fix XML::Writer already?
	155	local $^W = 0;
	156	require XML::Writer;
	157	import XML::Writer;
	158	}
0a689100	159
23735f6a	160	# Which schema object attributes (methods) to write as xml elements rather than
	161	# as attributes. e.g. <comments>blah, blah...</comments>
	162	my @MAP_AS_ELEMENTS = qw/sql comments action extra/;
	163
	164
	165
0a689100	166	my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
b89a67a0	167	my $Name = 'sqlf';
375f0be1	168	my $PArgs = {};
f8622fbb	169	my $no_comments;
0a689100	170
	171	sub produce {
	172	my $translator = shift;
	173	my $schema = $translator->schema;
f8622fbb	174	$no_comments = $translator->no_comments;
0a689100	175	$PArgs = $translator->producer_args;
983ed646	176	my $newlines = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1;
983ed646	177	my $indent = defined $PArgs->{indent} ? $PArgs->{indent} : 2;
983ed646	178
23735f6a	179	# Setup the XML::Writer and set the namespace
b5bd4580	180	my $io;
983ed646	181	my $prefix = "";
	182	$prefix = $Name if $PArgs->{add_prefix};
	183	$prefix = $PArgs->{prefix} if $PArgs->{prefix};
0a689100	184	my $xml = XML::Writer->new(
b5bd4580	185	OUTPUT => \$io,
0a689100	186	NAMESPACES => 1,
983ed646	187	PREFIX_MAP => { $Namespace => $prefix },
	188	DATA_MODE => $newlines,
	189	DATA_INDENT => $indent,
0a689100	190	);
0a689100	191
23735f6a	192	# Start the document
0a689100	193	$xml->xmlDecl('UTF-8');
f8622fbb	194
	195	$xml->comment(header_comment('', ''))
	196	unless $no_comments;
	197
1caf2bb2	198	xml_obj($xml, $schema,
0eebe059	199	tag => "schema", methods => [qw/name database extra/], end_tag => 0 );
0a689100	200
	201	#
	202	# Table
	203	#
87c5565e	204	$xml->startTag( [ $Namespace => "tables" ] );
0a689100	205	for my $table ( $schema->get_tables ) {
0a689100	206	debug "Table:",$table->name;
d3422086	207	xml_obj($xml, $table,
87c5565e	208	tag => "table",
0eebe059	209	methods => [qw/name order extra/],
87c5565e	210	end_tag => 0
87c5565e	211	);
0a689100	212
	213	#
	214	# Fields
	215	#
87c5565e	216	xml_obj_children( $xml, $table,
	217	tag => 'field',
	218	methods =>[qw/
	219	name data_type size is_nullable default_value is_auto_increment
	220	is_primary_key is_foreign_key extra comments order
	221	/],
	222	);
0a689100	223
	224	#
	225	# Indices
	226	#
87c5565e	227	xml_obj_children( $xml, $table,
	228	tag => 'index',
	229	collection_tag => "indices",
0eebe059	230	methods => [qw/name type fields options extra/],
87c5565e	231	);
0a689100	232
	233	#
	234	# Constraints
	235	#
87c5565e	236	xml_obj_children( $xml, $table,
	237	tag => 'constraint',
	238	methods => [qw/
	239	name type fields reference_table reference_fields
	240	on_delete on_update match_type expression options deferrable
0eebe059	241	extra
87c5565e	242	/],
87c5565e	243	);
0a689100	244
7c71eaab	245	#
	246	# Comments
	247	#
	248	xml_obj_children( $xml, $table,
	249	tag => 'comment',
	250	collection_tag => "comments",
	251	methods => [qw/
	252	comments
	253	/],
	254	);
	255
0a689100	256	$xml->endTag( [ $Namespace => 'table' ] );
0a689100	257	}
87c5565e	258	$xml->endTag( [ $Namespace => 'tables' ] );
d3422086	259
1e3867bf	260	#
	261	# Views
	262	#
87c5565e	263	xml_obj_children( $xml, $schema,
87c5565e	264	tag => 'view',
0eebe059	265	methods => [qw/name sql fields order extra/],
87c5565e	266	);
d3422086	267
1e3867bf	268	#
	269	# Tiggers
	270	#
87c5565e	271	xml_obj_children( $xml, $schema,
87c5565e	272	tag => 'trigger',
222094af	273	methods => [qw/name database_events action on_table perform_action_when
c0ec0e22	274	fields order extra scope/],
87c5565e	275	);
0a689100	276
1e3867bf	277	#
	278	# Procedures
	279	#
87c5565e	280	xml_obj_children( $xml, $schema,
87c5565e	281	tag => 'procedure',
0eebe059	282	methods => [qw/name sql parameters owner comments order extra/],
87c5565e	283	);
d3422086	284
0a689100	285	$xml->endTag([ $Namespace => 'schema' ]);
	286	$xml->end;
	287
	288	return $io;
	289	}
	290
87c5565e	291
	292	#
	293	# Takes and XML::Write object, Schema::* parent object, the tag name,
	294	# the collection name and a list of methods (of the children) to write as XML.
	295	# The collection name defaults to the name with an s on the end and is used to
	296	# work out the method to get the children with. eg a name of 'foo' gives a
	297	# collection of foos and gets the members using ->get_foos.
	298	#
	299	sub xml_obj_children {
	300	my ($xml,$parent) = (shift,shift);
	301	my %args = @_;
	302	my ($name,$collection_name,$methods)
	303	= @args{qw/tag collection_tag methods/};
	304	$collection_name \|\|= "${name}s";
7c71eaab	305
	306	my $meth;
	307	if ( $collection_name eq 'comments' ) {
	308	$meth = 'comments';
	309	} else {
	310	$meth = "get_$collection_name";
	311	}
87c5565e	312
	313	my @kids = $parent->$meth;
	314	#@kids \|\| return;
	315	$xml->startTag( [ $Namespace => $collection_name ] );
7c71eaab	316
87c5565e	317	for my $obj ( @kids ) {
7c71eaab	318	if ( $collection_name eq 'comments' ){
	319	$xml->dataElement( [ $Namespace => 'comment' ], $obj );
	320	} else {
	321	xml_obj($xml, $obj,
	322	tag => "$name",
	323	end_tag => 1,
	324	methods => $methods,
	325	);
	326	}
87c5565e	327	}
	328	$xml->endTag( [ $Namespace => $collection_name ] );
	329	}
	330
1caf2bb2	331	#
23735f6a	332	# Takes an XML::Writer, Schema::* object and list of method names
a37acd3a	333	# and writes the object out as XML. All methods values are written as attributes
87c5565e	334	# except for the methods listed in @MAP_AS_ELEMENTS which get written as child
87c5565e	335	# data elements.
b89a67a0	336	#
23735f6a	337	# The attributes/tags are written in the same order as the method names are
b89a67a0	338	# passed.
	339	#
	340	# TODO
1caf2bb2	341	# - Should the Namespace be passed in instead of global? Pass in the same
	342	# as Writer ie [ NS => TAGNAME ]
	343	#
23735f6a	344	my $elements_re = join("\|", @MAP_AS_ELEMENTS);
23735f6a	345	$elements_re = qr/^($elements_re)$/;
0a689100	346	sub xml_obj {
d3422086	347	my ($xml, $obj, %args) = @_;
	348	my $tag = $args{'tag'} \|\| '';
	349	my $end_tag = $args{'end_tag'} \|\| '';
d3422086	350	my @meths = @{ $args{'methods'} };
	351	my $empty_tag = 0;
	352
a37acd3a	353	# Use array to ensure consistent (ie not hash) ordering of attribs
b89a67a0	354	# The order comes from the meths list passed in.
	355	my @tags;
	356	my @attr;
	357	foreach ( grep { defined $obj->$_ } @meths ) {
23735f6a	358	my $what = m/$elements_re/ ? \@tags : \@attr;
e0a0c3e1	359	my $val = $_ eq 'extra'
	360	? { $obj->$_ }
	361	: $obj->$_;
0a689100	362	$val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
b89a67a0	363	push @$what, $_ => $val;
	364	};
	365	my $child_tags = @tags;
	366	$end_tag && !$child_tags
	367	? $xml->emptyTag( [ $Namespace => $tag ], @attr )
	368	: $xml->startTag( [ $Namespace => $tag ], @attr );
	369	while ( my ($name,$val) = splice @tags,0,2 ) {
e0a0c3e1	370	if ( ref $val eq 'HASH' ) {
	371	$xml->emptyTag( [ $Namespace => $name ],
	372	map { ($_, $val->{$_}) } sort keys %$val );
	373	}
	374	else {
	375	$xml->dataElement( [ $Namespace => $name ], $val );
	376	}
0a689100	377	}
b89a67a0	378	$xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag;
0a689100	379	}
	380
	381	1;
	382
	383	# -------------------------------------------------------------------
	384	# The eyes of fire, the nostrils of air,
	385	# The mouth of water, the beard of earth.
	386	# William Blake
	387	# -------------------------------------------------------------------
	388
	389	=pod
	390
	391	=head1 AUTHORS
	392
f997b9ab	393	Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
d3422086	394	Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
0a689100	395	Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
	396
	397	=head1 SEE ALSO
	398
0e9badbf	399	C<perl(1)>, L<SQL::Translator>, L<SQL::Translator::Parser::XML::SQLFairy>,
91f28468	400	L<SQL::Translator::Schema>, L<XML::Writer>.
0a689100	401
0a689100	402	=cut