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

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

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