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

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

# -------------------------------------------------------------------
# $Id: SQLFairy.pm,v 1.7 2004-07-08 19:34:29 grommit Exp $
# -------------------------------------------------------------------
# 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;
  use SQL::Translator::Parser::XML::SQLFairy;

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

  print $obj->translate;

=head1 DESCRIPTION

This parser handles the flavor of XML used natively by the SQLFairy
project (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 tag out all together to use the default in Schema::Field.
Use empty tags 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:default_value></sqlf:default_value>             <!-- Empty string -->
  <sqlf:default_value>EMPTY_STRING</sqlf:default_value> <!-- Empty string -->
  <sqlf:default_value/>                                 <!-- Empty string -->
  <sqlf:default_value>NULL</sqlf:default_value>         <!-- 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.
The old format is B<heavily depreciated> and B<will not> be supported in future
versions.

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 = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 0 unless defined $DEBUG;

use Data::Dumper;
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');
    for my $tblnode (
        sort {
            "".$xp->findvalue('sqlf:order|@order',$a)
            <=>
            "".$xp->findvalue('sqlf:order|@order',$b)
        } @nodes
    ) {
        debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);

        my $table = $schema->add_table(
            get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
        ) 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 
                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.
            # - Deal with $field->extra
            #
        }

        #
        # 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_do on_update_do/
            );
            $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/);
            $table->add_index( %data ) or die $table->error;
        }

    } # tables loop

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

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

    #
    # Procedures
    #
    @nodes = $xp->findnodes('/sqlf:schema/sqlf:procedure');
    foreach (@nodes) {
        my %data = get_tagfields($xp, $_, "sqlf:",
        qw/name sql parameters owner comments order/
        );
        $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$/ ? 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) ) {
            $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 TODO

=over 4

=item *

Support options and extra attributes.

=item *

Test foreign keys are parsed ok.

=item *

Control over defaulting of non-existant tags.

=back

=head1 AUTHOR

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

=head1 SEE ALSO

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

=cut
Commit	Line	Data
0a1ec87a	1	package SQL::Translator::Parser::XML::SQLFairy;
	2
	3	# -------------------------------------------------------------------
4a268a6c	4	# $Id: SQLFairy.pm,v 1.7 2004-07-08 19:34:29 grommit Exp $
0a1ec87a	5	# -------------------------------------------------------------------
	6	# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
	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;
	30	use SQL::Translator::Parser::XML::SQLFairy;
	31
	32	my $translator = SQL::Translator->new(
	33	from => 'XML-SQLFairy',
	34	to => 'MySQL',
	35	filename => 'schema.xml',
	36	show_warnings => 1,
	37	add_drop_table => 1,
	38	);
	39
	40	print $obj->translate;
	41
	42	=head1 DESCRIPTION
	43
	44	This parser handles the flavor of XML used natively by the SQLFairy
	45	project (SQL::Translator). The XML must be in the namespace
	46	"http://sqlfairy.sourceforge.net/sqlfairy.xml."
8571d198	47	See L<SQL::Translator::Producer::XML::SQLFairy> for details of this format.
0a1ec87a	48
8571d198	49	You do not need to specify every attribute of the Schema objects as any missing
	50	from the XML will be set to their default values. e.g. A field could be written
	51	using only;
0a1ec87a	52
8571d198	53	<sqlf:field name="email" data_type="varchar" size="255" />
0a1ec87a	54
8571d198	55	Instead of the full;
0a1ec87a	56
8571d198	57	<sqlf:field name="email" data_type="varchar" size="255" is_nullable="1"
	58	is_auto_increment="0" is_primary_key="0" is_foreign_key="0" order="4">
	59	<sqlf:comments></sqlf:comments>
	60	</sqlf:field>
0a1ec87a	61
8571d198	62	If you do not explicitly set the order of items using order attributes on the
8571d198	63	tags then the order the tags appear in the XML will be used.
0a1ec87a	64
	65	=head2 default_value
	66
a5e624ac	67	Leave the tag out all together to use the default in Schema::Field.
8571d198	68	Use empty tags or 'EMPTY_STRING' for a zero lenth string. 'NULL' for an
a5e624ac	69	explicit null (currently sets default_value to undef in the
a5e624ac	70	Schema::Field obj).
0a1ec87a	71
a5e624ac	72	<sqlf:default_value></sqlf:default_value> <!-- Empty string -->
a5e624ac	73	<sqlf:default_value>EMPTY_STRING</sqlf:default_value> <!-- Empty string -->
8571d198	74	<sqlf:default_value/> <!-- Empty string -->
a5e624ac	75	<sqlf:default_value>NULL</sqlf:default_value> <!-- NULL -->
0a1ec87a	76
0a1ec87a	77	=head2 ARGS
	78
	79	Doesn't take any extra parser args at the moment.
	80
4a268a6c	81	=head1 LEGACY FORMAT
	82
	83	The previous version of the SQLFairy XML allowed the attributes of the the
	84	schema objects to be written as either xml attributes or as data elements, in
	85	any combination. While this allows for lots of flexibility in writing the XML
	86	the result is a great many possible XML formats, not so good for DTD writing,
	87	XPathing etc! So we have moved to a fixed version described in
	88	L<SQL::Translator::Producer::XML::SQLFairy>.
	89
	90	This version of the parser will still parse the old formats and emmit warnings
	91	when it sees them being used.
	92	The old format is B<heavily depreciated> and B<will not> be supported in future
	93	versions.
	94
	95	To convert your old format files simply pass them through the translator;
	96
	97	sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml
	98
0a1ec87a	99	=cut
	100
	101	# -------------------------------------------------------------------
	102
	103	use strict;
	104
	105	use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
4a268a6c	106	$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
0a1ec87a	107	$DEBUG = 0 unless defined $DEBUG;
	108
	109	use Data::Dumper;
	110	use Exporter;
	111	use base qw(Exporter);
	112	@EXPORT_OK = qw(parse);
	113
	114	use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
a5e624ac	115	use SQL::Translator::Utils 'debug';
0a1ec87a	116	use XML::XPath;
	117	use XML::XPath::XMLParser;
	118
0a1ec87a	119	sub parse {
0a1ec87a	120	my ( $translator, $data ) = @_;
a5e624ac	121	my $schema = $translator->schema;
	122	local $DEBUG = $translator->debug;
	123	my $xp = XML::XPath->new(xml => $data);
0a1ec87a	124
0a1ec87a	125	$xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
0a1ec87a	126
a5e624ac	127	#
0a1ec87a	128	# Work our way through the tables
	129	#
	130	my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
	131	for my $tblnode (
8571d198	132	sort {
59b2ec83	133	"".$xp->findvalue('sqlf:order\|@order',$a)
8571d198	134	<=>
8571d198	135	"".$xp->findvalue('sqlf:order\|@order',$b)
a5e624ac	136	} @nodes
0a1ec87a	137	) {
0a1ec87a	138	debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
a5e624ac	139
0a1ec87a	140	my $table = $schema->add_table(
	141	get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
	142	) or die $schema->error;
	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:",
a5e624ac	156	qw/name data_type size default_value is_nullable
	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.
	180	# - Deal with $field->extra
	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
	191	match_type on_delete_do on_update_do/
	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:",
a5e624ac	202	qw/name type fields options/);
19922fbc	203	$table->add_index( %data ) or die $table->error;
0a1ec87a	204	}
	205
	206	} # tables loop
	207
19922fbc	208	#
	209	# Views
	210	#
	211	@nodes = $xp->findnodes('/sqlf:schema/sqlf:view');
	212	foreach (@nodes) {
	213	my %data = get_tagfields($xp, $_, "sqlf:",
	214	qw/name sql fields order/
	215	);
	216	$schema->add_view( %data ) or die $schema->error;
	217	}
8571d198	218
19922fbc	219	#
	220	# Triggers
	221	#
	222	@nodes = $xp->findnodes('/sqlf:schema/sqlf:trigger');
	223	foreach (@nodes) {
	224	my %data = get_tagfields($xp, $_, "sqlf:",
	225	qw/name perform_action_when database_event fields on_table action order/
	226	);
	227	$schema->add_trigger( %data ) or die $schema->error;
	228	}
8571d198	229
19922fbc	230	#
	231	# Procedures
	232	#
	233	@nodes = $xp->findnodes('/sqlf:schema/sqlf:procedure');
	234	foreach (@nodes) {
	235	my %data = get_tagfields($xp, $_, "sqlf:",
	236	qw/name sql parameters owner comments order/
	237	);
	238	$schema->add_procedure( %data ) or die $schema->error;
	239	}
8571d198	240
0a1ec87a	241	return 1;
	242	}
	243
a5e624ac	244	# -------------------------------------------------------------------
	245	sub get_tagfields {
	246	#
8571d198	247	# get_tagfields XP, NODE, NAMESPACE => qw/TAGNAMES/;
0a1ec87a	248	# get_tagfields $node, "sqlf:" => qw/name type fields reference/;
0a1ec87a	249	#
8571d198	250	# Returns hash of data.
8571d198	251	# TODO - Add handling of an explicit NULL value.
a5e624ac	252	#
a5e624ac	253
0a1ec87a	254	my ($xp, $node, @names) = @_;
	255	my (%data, $ns);
	256	foreach (@names) {
	257	if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
	258	my $thisns = (s/(^.*?:)// ? $1 : $ns);
a5e624ac	259
8571d198	260	my $is_attrib = m/^sql\|comments\|action$/ ? 0 : 1;
a5e624ac	261
8571d198	262	my $attrib_path = "\@$thisns$_";
	263	my $tag_path = "$thisns$_";
	264	if ( $xp->exists($attrib_path,$node) ) {
	265	$data{$_} = "".$xp->findvalue($attrib_path,$node);
	266	warn "Use of '$_' as an attribute is depricated."
	267	." Use a child tag instead."
	268	." To convert your file to the new version see the Docs.\n"
	269	unless $is_attrib;
	270	debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
	271	}
	272	elsif ( $xp->exists($tag_path,$node) ) {
	273	$data{$_} = "".$xp->findvalue($tag_path,$node);
	274	warn "Use of '$_' as a child tag is depricated."
	275	." Use an attribute instead."
	276	." To convert your file to the new version see the Docs.\n"
	277	if $is_attrib;
a5e624ac	278	debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
0a1ec87a	279	}
0a1ec87a	280	}
a5e624ac	281
0a1ec87a	282	return wantarray ? %data : \%data;
	283	}
	284
	285	1;
	286
	287	# -------------------------------------------------------------------
	288
	289	=pod
	290
	291	=head1 BUGS
	292
8571d198	293	Ignores the order attribute for Constraints, Views, Indices,
	294	Views, Triggers and Procedures, using the tag order instead. (This is the order
	295	output by the SQLFairy XML producer).
0a1ec87a	296
	297	=head1 TODO
	298
	299	=over 4
	300
8571d198	301	=item *
a5e624ac	302
8571d198	303	Support options and extra attributes.
a5e624ac	304
8571d198	305	=item *
0a1ec87a	306
8571d198	307	Test foreign keys are parsed ok.
0a1ec87a	308
8571d198	309	=item *
0a1ec87a	310
a5e624ac	311	Control over defaulting of non-existant tags.
0a1ec87a	312
	313	=back
	314
	315	=head1 AUTHOR
	316
	317	Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
	318
	319	=head1 SEE ALSO
	320
	321	perl(1), SQL::Translator, SQL::Translator::Producer::XML::SQLFairy,
	322	SQL::Translator::Schema.
	323
	324	=cut