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

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

# -------------------------------------------------------------------
# $Id: SQLFairy.pm,v 1.16 2004-08-18 20:27:58 grommit Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
#                    darren chamberlain <darren@cpan.org>,
#                    Chris Mungall <cjm@fruitfly.org>,
#                    Mark Addison <mark.addison@itn.co.uk>.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=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,
      add_drop_table => 1,
  );

  print $t->translate;

=head1 DESCRIPTION

Creates XML output of a schema, in SQLFairy format XML.

The XML lives in the 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.

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 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=""
      xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml">

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

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

    </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 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 vars qw[ $VERSION @EXPORT_OK ];
$VERSION = sprintf "%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/;

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

use IO::Scalar;
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     = {};

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

    # Setup the XML::Writer and set the namespace
    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('', ''));
    xml_obj($xml, $schema,
        tag => "schema", methods => [qw/name database/], end_tag => 0 );

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

        #
        # Fields
        #
        $xml->startTag( [ $Namespace => 'fields' ] );
        for my $field ( $table->get_fields ) {
            debug "    Field:",$field->name;
            xml_obj($xml, $field,
                tag     =>"field",
                end_tag => 1,
                methods =>[qw/name data_type size is_nullable default_value
                    is_auto_increment is_primary_key is_foreign_key extra comments order
                /],
            );
        }
        $xml->endTag( [ $Namespace => 'fields' ] );

        #
        # Indices
        #
        $xml->startTag( [ $Namespace => 'indices' ] );
        for my $index ( $table->get_indices ) {
            debug "Index:",$index->name;
            xml_obj($xml, $index,
                tag     => "index",
                end_tag => 1,
                methods =>[qw/ name type fields options/],
            );
        }
        $xml->endTag( [ $Namespace => 'indices' ] );

        #
        # Constraints
        #
        $xml->startTag( [ $Namespace => 'constraints' ] );
        for my $index ( $table->get_constraints ) {
            debug "Constraint:",$index->name;
            xml_obj($xml, $index,
                tag     => "constraint",
                end_tag => 1,
                methods =>[qw/
                    name type fields reference_table reference_fields
                    on_delete on_update match_type expression options deferrable
                    /],
            );
        }
        $xml->endTag( [ $Namespace => 'constraints' ] );

        $xml->endTag( [ $Namespace => 'table' ] );
    }

    #
    # Views
    #
    for my $foo ( $schema->get_views ) {
        xml_obj($xml, $foo, tag => "view",
        methods => [qw/name sql fields order/], end_tag => 1 );
    }

    #
    # Tiggers
    #
    for my $foo ( $schema->get_triggers ) {
        xml_obj($xml, $foo, tag => "trigger",
        methods => [qw/name database_event action on_table perform_action_when
        fields order/], end_tag => 1 );
    }

    #
    # Procedures
    #
    for my $foo ( $schema->get_procedures ) {
        xml_obj($xml, $foo, tag => "procedure",
        methods => [qw/name sql parameters owner comments order/], end_tag=>1 );
    }

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

    return $io;
}

# -------------------------------------------------------------------
#
# Takes an XML::Writer, Schema::* object and list of method names
# and writes the obect out as XML. All methods values are written as attributes
# except for comments, sql and action 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 consistant (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 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

perl(1), SQL::Translator, SQL::Translator::Parser::XML::SQLFairy,
SQL::Translator::Schema, XML::Writer.

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