[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>,
# Copyright (C) 2009 Jonathan Yu <frequency@cpan.org>
#
# 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::LibXML 1.69;
use XML::LibXML::XPathContext;

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

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