package SQL::Translator::Parser::XML::SQLFairy;
# -------------------------------------------------------------------
-# $Id: SQLFairy.pm,v 1.7 2004-07-08 19:34:29 grommit Exp $
+# $Id: SQLFairy.pm,v 1.15 2005-07-05 16:20:42 mwz444 Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
=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,
- );
+ my $translator = SQL::Translator->new( show_warnings => 1 );
- print $obj->translate;
+ 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 (SQL::Translator). The XML must be in the namespace
+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.
=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
+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: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 -->
+ <sqlf:field default_value="" /> <!-- Empty string -->
+ <sqlf:field default_value="EMPTY_STRING" /> <!-- Empty string -->
+ <sqlf:field default_value="NULL" /> <!-- NULL -->
=head2 ARGS
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.
+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;
+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
+ $ 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+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
#
# Work our way through the tables
#
- my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
+ my @nodes = $xp->findnodes(
+ '/sqlf:schema/sqlf:table|/sqlf:schema/sqlf:tables/sqlf:table'
+ );
for my $tblnode (
sort {
- "".$xp->findvalue('sqlf:order|@order',$a)
+ ("".$xp->findvalue('sqlf:order|@order',$a) || 0)
<=>
- "".$xp->findvalue('sqlf:order|@order',$b)
+ ("".$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/)
+ get_tagfields($xp, $tblnode, "sqlf:" => qw/name order extra/)
) or die $schema->error;
#
} @nodes
) {
my %fdata = get_tagfields($xp, $_, "sqlf:",
- qw/name data_type size default_value is_nullable
+ qw/name data_type size default_value is_nullable extra
is_auto_increment is_primary_key is_foreign_key comments/
);
# TODO:
# - We should be able to make the table obj spot this when
# we use add_field.
- # - Deal with $field->extra
#
}
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/
+ match_type on_delete on_update extra/
);
$table->add_constraint( %data ) or die $table->error;
}
@nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
foreach (@nodes) {
my %data = get_tagfields($xp, $_, "sqlf:",
- qw/name type fields options/);
+ 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');
+ @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/
+ qw/name sql fields order extra/
);
$schema->add_view( %data ) or die $schema->error;
}
#
# Triggers
#
- @nodes = $xp->findnodes('/sqlf:schema/sqlf:trigger');
+ @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 fields on_table action order/
- );
+ my %data = get_tagfields($xp, $_, "sqlf:", qw/
+ name perform_action_when database_event fields on_table action order
+ extra
+ /);
$schema->add_trigger( %data ) or die $schema->error;
}
#
# Procedures
#
- @nodes = $xp->findnodes('/sqlf:schema/sqlf:procedure');
+ @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/
+ qw/name sql parameters owner comments order extra/
);
$schema->add_procedure( %data ) or die $schema->error;
}
if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
my $thisns = (s/(^.*?:)// ? $1 : $ns);
- my $is_attrib = m/^sql|comments|action$/ ? 0 : 1;
+ my $is_attrib = m/^(sql|comments|action|extra)$/ ? 0 : 1;
my $attrib_path = "\@$thisns$_";
my $tag_path = "$thisns$_";
debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
}
elsif ( $xp->exists($tag_path,$node) ) {
- $data{$_} = "".$xp->findvalue($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"
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 and extra attributes.
+Support options attribute.
=item *
=item *
-Control over defaulting of non-existant tags.
+Control over defaulting.
=back
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