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

package SQL::Translator::Parser::XML::SQLFairy;

# -------------------------------------------------------------------
# Copyright (C) 2003 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
# -------------------------------------------------------------------

=head1 NAME

SQL::Translator::Parser::XML::SQLFairy - parser for SQL::Translator's XML.

=head1 SYNOPSIS

  use SQL::Translator;

  my $translator = SQL::Translator->new( show_warnings  => 1 );

  my $out = $obj->translate(
      from     => 'XML-SQLFairy',
      to       => 'MySQL',
      filename => 'schema.xml',
  ) or die $translator->error;

  print $out;

=head1 DESCRIPTION

This parser handles the flavor of XML used natively by the SQLFairy
project (L<SQL::Translator>).  The XML must be in the namespace
"http://sqlfairy.sourceforge.net/sqlfairy.xml."
See L<SQL::Translator::Producer::XML::SQLFairy> for details of this format.

You do not need to specify every attribute of the Schema objects as any missing
from the XML will be set to their default values. e.g. A field could be written
using only;

 <sqlf:field name="email" data_type="varchar" size="255" />

Instead of the full;

 <sqlf: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">
   <sqlf:comments></sqlf:comments>
 </sqlf:field>

If you do not explicitly set the order of items using order attributes on the
tags then the order the tags appear in the XML will be used.

=head2 default_value

Leave the attribute out all together to use the default in L<Schema::Field>.
Use empty quotes or 'EMPTY_STRING' for a zero lenth string. 'NULL' for an
explicit null (currently sets default_value to undef in the
Schema::Field obj).

  <sqlf:field default_value="" />                <!-- Empty string -->
  <sqlf:field default_value="EMPTY_STRING" />    <!-- Empty string -->
  <sqlf:field default_value="NULL" />            <!-- NULL -->

=head2 ARGS

Doesn't take any extra parser args at the moment.

=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. While this allows 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 in
L<SQL::Translator::Producer::XML::SQLFairy>.

This version of the parser will still parse the old formats and emmit warnings
when it sees them being used but they should be considered B<heavily
depreciated>.

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[ $DEBUG $VERSION @EXPORT_OK ];
$VERSION = '1.59';
$DEBUG   = 0 unless defined $DEBUG;

use Data::Dumper;
use Carp::Clan qw/^SQL::Translator/;
use Exporter;
use base qw(Exporter);
@EXPORT_OK = qw(parse);

use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
use SQL::Translator::Utils 'debug';
use XML::XPath;
use XML::XPath::XMLParser;

sub parse {
    my ( $translator, $data ) = @_;
    my $schema                = $translator->schema;
    local $DEBUG              = $translator->debug;
    my $xp                    = XML::XPath->new(xml => $data);

    $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");

    #
    # Work our way through the tables
    #
    my @nodes = $xp->findnodes(
        '/sqlf:schema/sqlf:table|/sqlf:schema/sqlf:tables/sqlf:table'
    );
    for my $tblnode (
        sort {
            ("".$xp->findvalue('sqlf:order|@order',$a) || 0)
            <=>
            ("".$xp->findvalue('sqlf:order|@order',$b) || 0)
        } @nodes
    ) {
        debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);

        my $table = $schema->add_table(
            get_tagfields($xp, $tblnode, "sqlf:" => qw/name order extra/)
        ) or die $schema->error;

        #
        # Fields
        #
        my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
        foreach (
            sort {
                ("".$xp->findvalue('sqlf:order',$a) || 0)
                <=>
                ("".$xp->findvalue('sqlf:order',$b) || 0)
            } @nodes
        ) {
            my %fdata = get_tagfields($xp, $_, "sqlf:",
                qw/name data_type size default_value is_nullable extra
                is_auto_increment is_primary_key is_foreign_key comments/
            );

            if (
                exists $fdata{'default_value'} and
                defined $fdata{'default_value'}
            ) {
                if ( $fdata{'default_value'} =~ /^\s*NULL\s*$/ ) {
                    $fdata{'default_value'}= undef;
                }
                elsif ( $fdata{'default_value'} =~ /^\s*EMPTY_STRING\s*$/ ) {
                    $fdata{'default_value'} = "";
                }
            }

            my $field = $table->add_field( %fdata ) or die $table->error;

            $table->primary_key( $field->name ) if $fdata{'is_primary_key'};

            #
            # TODO:
            # - We should be able to make the table obj spot this when
            #   we use add_field.
            #
        }

        #
        # Constraints
        #
        @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
        foreach (@nodes) {
            my %data = get_tagfields($xp, $_, "sqlf:",
                qw/name type table fields reference_fields reference_table
                match_type on_delete on_update extra/
            );
            $table->add_constraint( %data ) or die $table->error;
        }

        #
        # Indexes
        #
        @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
        foreach (@nodes) {
            my %data = get_tagfields($xp, $_, "sqlf:",
                qw/name type fields options extra/);
            $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

    #
    # Views
    #
    @nodes = $xp->findnodes(
        '/sqlf:schema/sqlf:view|/sqlf:schema/sqlf:views/sqlf:view'
    );
    foreach (@nodes) {
        my %data = get_tagfields($xp, $_, "sqlf:",
            qw/name sql fields order extra/
        );
        $schema->add_view( %data ) or die $schema->error;
    }

    #
    # Triggers
    #
    @nodes = $xp->findnodes(
        '/sqlf:schema/sqlf:trigger|/sqlf:schema/sqlf:triggers/sqlf:trigger'
    );
    foreach (@nodes) {
        my %data = get_tagfields($xp, $_, "sqlf:", qw/
            name perform_action_when database_event database_events fields on_table action order
            extra
        /);

        # back compat
        if (my $evt = $data{database_event} and $translator->{show_warnings}) {
          carp 'The database_event tag is deprecated - please use database_events (which can take one or more comma separated event names)';
          $data{database_events} = join (', ',
            $data{database_events} || (),
            $evt,
          );
        }

        # split into arrayref
        if (my $evts = $data{database_events}) {
          $data{database_events} = [split (/\s*,\s*/, $evts) ];
        }

        $schema->add_trigger( %data ) or die $schema->error;
    }

    #
    # Procedures
    #
    @nodes = $xp->findnodes(
       '/sqlf:schema/sqlf:procedure|/sqlf:schema/sqlf:procedures/sqlf:procedure'
    );
    foreach (@nodes) {
        my %data = get_tagfields($xp, $_, "sqlf:",
        qw/name sql parameters owner comments order extra/
        );
        $schema->add_procedure( %data ) or die $schema->error;
    }

    return 1;
}

# -------------------------------------------------------------------
sub get_tagfields {
#
# get_tagfields XP, NODE, NAMESPACE => qw/TAGNAMES/;
# get_tagfields $node, "sqlf:" => qw/name type fields reference/;
#
# Returns hash of data.
# TODO - Add handling of an explicit NULL value.
#

    my ($xp, $node, @names) = @_;
    my (%data, $ns);
    foreach (@names) {
        if ( m/:$/ ) { $ns = $_; next; }  # Set def namespace
        my $thisns = (s/(^.*?:)// ? $1 : $ns);

        my $is_attrib = m/^(sql|comments|action|extra)$/ ? 0 : 1;

        my $attrib_path = "\@$thisns$_";
        my $tag_path    = "$thisns$_";
        if ( $xp->exists($attrib_path,$node) ) {
            $data{$_} = "".$xp->findvalue($attrib_path,$node);
            warn "Use of '$_' as an attribute is depricated."
                ." Use a child tag instead."
                ." To convert your file to the new version see the Docs.\n"
                unless $is_attrib;
            debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
        }
        elsif ( $xp->exists($tag_path,$node) ) {
            if ($_ eq "extra") {
                my %extra;
                my $extra_nodes = $xp->find($tag_path,$node);
                foreach ( $extra_nodes->pop->getAttributes ) {
                    $extra{$_->getName} = $_->getData;
                }
                $data{$_} = \%extra;
            }
            else {
                $data{$_} = "".$xp->findvalue($tag_path,$node);
            }
            warn "Use of '$_' as a child tag is depricated."
                ." Use an attribute instead."
                ." To convert your file to the new version see the Docs.\n"
                if $is_attrib;
            debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
        }
    }

    return wantarray ? %data : \%data;
}

1;

# -------------------------------------------------------------------

=pod

=head1 BUGS

Ignores the order attribute for Constraints, Views, Indices,
Views, Triggers and Procedures, using the tag order instead. (This is the order
output by the SQLFairy XML producer).

=head1 SEE ALSO

L<perl>, L<SQL::Translator>, L<SQL::Translator::Producer::XML::SQLFairy>,
L<SQL::Translator::Schema>.

=head1 TODO

=over 4

=item *

Support options attribute.

=item *

Test foreign keys are parsed ok.

=item *

Control over defaulting.

=back

=head1 AUTHOR

Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.

=cut
Commit	Line	Data
0a1ec87a	1	package SQL::Translator::Parser::XML::SQLFairy;
	2
	3	# -------------------------------------------------------------------
0a1ec87a	4	# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
	5	#
	6	# This program is free software; you can redistribute it and/or
	7	# modify it under the terms of the GNU General Public License as
	8	# published by the Free Software Foundation; version 2.
	9	#
	10	# This program is distributed in the hope that it will be useful, but
	11	# WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	13	# General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with this program; if not, write to the Free Software
	17	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
	18	# 02111-1307 USA
	19	# -------------------------------------------------------------------
	20
	21	=head1 NAME
	22
8571d198	23	SQL::Translator::Parser::XML::SQLFairy - parser for SQL::Translator's XML.
0a1ec87a	24
	25	=head1 SYNOPSIS
	26
	27	use SQL::Translator;
0a1ec87a	28
85633bfb	29	my $translator = SQL::Translator->new( show_warnings => 1 );
0a1ec87a	30
85633bfb	31	my $out = $obj->translate(
	32	from => 'XML-SQLFairy',
	33	to => 'MySQL',
	34	filename => 'schema.xml',
	35	) or die $translator->error;
	36
	37	print $out;
0a1ec87a	38
	39	=head1 DESCRIPTION
	40
	41	This parser handles the flavor of XML used natively by the SQLFairy
91f28468	42	project (L<SQL::Translator>). The XML must be in the namespace
0a1ec87a	43	"http://sqlfairy.sourceforge.net/sqlfairy.xml."
8571d198	44	See L<SQL::Translator::Producer::XML::SQLFairy> for details of this format.
0a1ec87a	45
8571d198	46	You do not need to specify every attribute of the Schema objects as any missing
	47	from the XML will be set to their default values. e.g. A field could be written
	48	using only;
0a1ec87a	49
8571d198	50	<sqlf:field name="email" data_type="varchar" size="255" />
0a1ec87a	51
8571d198	52	Instead of the full;
0a1ec87a	53
8571d198	54	<sqlf:field name="email" data_type="varchar" size="255" is_nullable="1"
	55	is_auto_increment="0" is_primary_key="0" is_foreign_key="0" order="4">
	56	<sqlf:comments></sqlf:comments>
	57	</sqlf:field>
0a1ec87a	58
8571d198	59	If you do not explicitly set the order of items using order attributes on the
8571d198	60	tags then the order the tags appear in the XML will be used.
0a1ec87a	61
	62	=head2 default_value
	63
91f28468	64	Leave the attribute out all together to use the default in L<Schema::Field>.
91f28468	65	Use empty quotes or 'EMPTY_STRING' for a zero lenth string. 'NULL' for an
a5e624ac	66	explicit null (currently sets default_value to undef in the
a5e624ac	67	Schema::Field obj).
0a1ec87a	68
91f28468	69	<sqlf:field default_value="" /> <!-- Empty string -->
	70	<sqlf:field default_value="EMPTY_STRING" /> <!-- Empty string -->
	71	<sqlf:field default_value="NULL" /> <!-- NULL -->
0a1ec87a	72
0a1ec87a	73	=head2 ARGS
	74
	75	Doesn't take any extra parser args at the moment.
	76
4a268a6c	77	=head1 LEGACY FORMAT
	78
	79	The previous version of the SQLFairy XML allowed the attributes of the the
	80	schema objects to be written as either xml attributes or as data elements, in
	81	any combination. While this allows for lots of flexibility in writing the XML
	82	the result is a great many possible XML formats, not so good for DTD writing,
	83	XPathing etc! So we have moved to a fixed version described in
	84	L<SQL::Translator::Producer::XML::SQLFairy>.
	85
	86	This version of the parser will still parse the old formats and emmit warnings
91f28468	87	when it sees them being used but they should be considered B<heavily
91f28468	88	depreciated>.
4a268a6c	89
91f28468	90	To convert your old format files simply pass them through the translator :)
4a268a6c	91
91f28468	92	$ sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml
4a268a6c	93
0a1ec87a	94	=cut
	95
	96	# -------------------------------------------------------------------
	97
	98	use strict;
	99
da06ac74	100	use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
4ab3763d	101	$VERSION = '1.59';
0a1ec87a	102	$DEBUG = 0 unless defined $DEBUG;
	103
	104	use Data::Dumper;
9768b204	105	use Carp::Clan qw/^SQL::Translator/;
0a1ec87a	106	use Exporter;
	107	use base qw(Exporter);
	108	@EXPORT_OK = qw(parse);
	109
	110	use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
a5e624ac	111	use SQL::Translator::Utils 'debug';
0a1ec87a	112	use XML::XPath;
	113	use XML::XPath::XMLParser;
	114
0a1ec87a	115	sub parse {
0a1ec87a	116	my ( $translator, $data ) = @_;
a5e624ac	117	my $schema = $translator->schema;
	118	local $DEBUG = $translator->debug;
	119	my $xp = XML::XPath->new(xml => $data);
0a1ec87a	120
0a1ec87a	121	$xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
0a1ec87a	122
a5e624ac	123	#
0a1ec87a	124	# Work our way through the tables
0a1ec87a	125	#
87c5565e	126	my @nodes = $xp->findnodes(
	127	'/sqlf:schema/sqlf:table\|/sqlf:schema/sqlf:tables/sqlf:table'
	128	);
0a1ec87a	129	for my $tblnode (
8571d198	130	sort {
53a533ef	131	("".$xp->findvalue('sqlf:order\|@order',$a) \|\| 0)
8571d198	132	<=>
53a533ef	133	("".$xp->findvalue('sqlf:order\|@order',$b) \|\| 0)
a5e624ac	134	} @nodes
0a1ec87a	135	) {
0a1ec87a	136	debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
a5e624ac	137
0a1ec87a	138	my $table = $schema->add_table(
b1789409	139	get_tagfields($xp, $tblnode, "sqlf:" => qw/name order extra/)
0a1ec87a	140	) or die $schema->error;
0a1ec87a	141
a5e624ac	142	#
0a1ec87a	143	# Fields
	144	#
	145	my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
	146	foreach (
8571d198	147	sort {
a5e624ac	148	("".$xp->findvalue('sqlf:order',$a) \|\| 0)
8571d198	149	<=>
8571d198	150	("".$xp->findvalue('sqlf:order',$b) \|\| 0)
a5e624ac	151	} @nodes
0a1ec87a	152	) {
0a1ec87a	153	my %fdata = get_tagfields($xp, $_, "sqlf:",
94ed484b	154	qw/name data_type size default_value is_nullable extra
a5e624ac	155	is_auto_increment is_primary_key is_foreign_key comments/
	156	);
	157
	158	if (
8571d198	159	exists $fdata{'default_value'} and
a5e624ac	160	defined $fdata{'default_value'}
	161	) {
	162	if ( $fdata{'default_value'} =~ /^\sNULL\s$/ ) {
	163	$fdata{'default_value'}= undef;
0a1ec87a	164	}
a5e624ac	165	elsif ( $fdata{'default_value'} =~ /^\sEMPTY_STRING\s$/ ) {
a5e624ac	166	$fdata{'default_value'} = "";
0a1ec87a	167	}
0a1ec87a	168	}
a5e624ac	169
19922fbc	170	my $field = $table->add_field( %fdata ) or die $table->error;
a5e624ac	171
	172	$table->primary_key( $field->name ) if $fdata{'is_primary_key'};
	173
	174	#
	175	# TODO:
8571d198	176	# - We should be able to make the table obj spot this when
a5e624ac	177	# we use add_field.
a5e624ac	178	#
0a1ec87a	179	}
0a1ec87a	180
a5e624ac	181	#
0a1ec87a	182	# Constraints
	183	#
	184	@nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
	185	foreach (@nodes) {
	186	my %data = get_tagfields($xp, $_, "sqlf:",
a5e624ac	187	qw/name type table fields reference_fields reference_table
100684f3	188	match_type on_delete on_update extra/
a5e624ac	189	);
19922fbc	190	$table->add_constraint( %data ) or die $table->error;
0a1ec87a	191	}
0a1ec87a	192
a5e624ac	193	#
0a1ec87a	194	# Indexes
	195	#
	196	@nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
	197	foreach (@nodes) {
	198	my %data = get_tagfields($xp, $_, "sqlf:",
b1789409	199	qw/name type fields options extra/);
19922fbc	200	$table->add_index( %data ) or die $table->error;
0a1ec87a	201	}
0a1ec87a	202
7c71eaab	203
	204	#
	205	# Comments
	206	#
	207	@nodes = $xp->findnodes('sqlf:comments/sqlf:comment',$tblnode);
	208	foreach (@nodes) {
	209	my $data = $_->string_value;
	210	$table->comments( $data );
	211	}
	212
0a1ec87a	213	} # tables loop
0a1ec87a	214
19922fbc	215	#
	216	# Views
	217	#
87c5565e	218	@nodes = $xp->findnodes(
	219	'/sqlf:schema/sqlf:view\|/sqlf:schema/sqlf:views/sqlf:view'
	220	);
19922fbc	221	foreach (@nodes) {
19922fbc	222	my %data = get_tagfields($xp, $_, "sqlf:",
b1789409	223	qw/name sql fields order extra/
19922fbc	224	);
	225	$schema->add_view( %data ) or die $schema->error;
	226	}
8571d198	227
19922fbc	228	#
	229	# Triggers
	230	#
87c5565e	231	@nodes = $xp->findnodes(
	232	'/sqlf:schema/sqlf:trigger\|/sqlf:schema/sqlf:triggers/sqlf:trigger'
	233	);
19922fbc	234	foreach (@nodes) {
b1789409	235	my %data = get_tagfields($xp, $_, "sqlf:", qw/
af858b8a	236	name perform_action_when database_event database_events fields on_table action order
b1789409	237	extra
b1789409	238	/);
af858b8a	239
af858b8a	240	# back compat
9768b204	241	if (my $evt = $data{database_event} and $translator->{show_warnings}) {
9768b204	242	carp 'The database_event tag is deprecated - please use database_events (which can take one or more comma separated event names)';
af858b8a	243	$data{database_events} = join (', ',
	244	$data{database_events} \|\| (),
	245	$evt,
	246	);
	247	}
	248
	249	# split into arrayref
	250	if (my $evts = $data{database_events}) {
	251	$data{database_events} = [split (/\s,\s/, $evts) ];
	252	}
	253
19922fbc	254	$schema->add_trigger( %data ) or die $schema->error;
19922fbc	255	}
8571d198	256
19922fbc	257	#
	258	# Procedures
	259	#
87c5565e	260	@nodes = $xp->findnodes(
	261	'/sqlf:schema/sqlf:procedure\|/sqlf:schema/sqlf:procedures/sqlf:procedure'
	262	);
19922fbc	263	foreach (@nodes) {
19922fbc	264	my %data = get_tagfields($xp, $_, "sqlf:",
b1789409	265	qw/name sql parameters owner comments order extra/
19922fbc	266	);
	267	$schema->add_procedure( %data ) or die $schema->error;
	268	}
8571d198	269
0a1ec87a	270	return 1;
	271	}
	272
a5e624ac	273	# -------------------------------------------------------------------
	274	sub get_tagfields {
	275	#
8571d198	276	# get_tagfields XP, NODE, NAMESPACE => qw/TAGNAMES/;
0a1ec87a	277	# get_tagfields $node, "sqlf:" => qw/name type fields reference/;
0a1ec87a	278	#
8571d198	279	# Returns hash of data.
8571d198	280	# TODO - Add handling of an explicit NULL value.
a5e624ac	281	#
a5e624ac	282
0a1ec87a	283	my ($xp, $node, @names) = @_;
	284	my (%data, $ns);
	285	foreach (@names) {
	286	if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
	287	my $thisns = (s/(^.*?:)// ? $1 : $ns);
a5e624ac	288
94ed484b	289	my $is_attrib = m/^(sql\|comments\|action\|extra)$/ ? 0 : 1;
a5e624ac	290
8571d198	291	my $attrib_path = "\@$thisns$_";
	292	my $tag_path = "$thisns$_";
	293	if ( $xp->exists($attrib_path,$node) ) {
	294	$data{$_} = "".$xp->findvalue($attrib_path,$node);
	295	warn "Use of '$_' as an attribute is depricated."
	296	." Use a child tag instead."
	297	." To convert your file to the new version see the Docs.\n"
	298	unless $is_attrib;
	299	debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
	300	}
	301	elsif ( $xp->exists($tag_path,$node) ) {
94ed484b	302	if ($_ eq "extra") {
	303	my %extra;
	304	my $extra_nodes = $xp->find($tag_path,$node);
	305	foreach ( $extra_nodes->pop->getAttributes ) {
	306	$extra{$_->getName} = $_->getData;
	307	}
	308	$data{$_} = \%extra;
	309	}
	310	else {
	311	$data{$_} = "".$xp->findvalue($tag_path,$node);
	312	}
8571d198	313	warn "Use of '$_' as a child tag is depricated."
	314	." Use an attribute instead."
	315	." To convert your file to the new version see the Docs.\n"
	316	if $is_attrib;
a5e624ac	317	debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
0a1ec87a	318	}
0a1ec87a	319	}
a5e624ac	320
0a1ec87a	321	return wantarray ? %data : \%data;
	322	}
	323
	324	1;
	325
	326	# -------------------------------------------------------------------
	327
	328	=pod
	329
	330	=head1 BUGS
	331
8571d198	332	Ignores the order attribute for Constraints, Views, Indices,
	333	Views, Triggers and Procedures, using the tag order instead. (This is the order
	334	output by the SQLFairy XML producer).
0a1ec87a	335
91f28468	336	=head1 SEE ALSO
	337
	338	L<perl>, L<SQL::Translator>, L<SQL::Translator::Producer::XML::SQLFairy>,
	339	L<SQL::Translator::Schema>.
	340
0a1ec87a	341	=head1 TODO
	342
	343	=over 4
	344
8571d198	345	=item *
a5e624ac	346
94ed484b	347	Support options attribute.
a5e624ac	348
8571d198	349	=item *
0a1ec87a	350
8571d198	351	Test foreign keys are parsed ok.
0a1ec87a	352
8571d198	353	=item *
0a1ec87a	354
91f28468	355	Control over defaulting.
0a1ec87a	356
	357	=back
	358
	359	=head1 AUTHOR
	360
	361	Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
	362
0a1ec87a	363	=cut