package SQL::Translator::Parser::XML::SQLFairy;
# -------------------------------------------------------------------
-# $Id: SQLFairy.pm,v 1.6 2004-07-08 19:06:24 grommit Exp $
+# $Id: SQLFairy.pm,v 1.9 2004-08-19 14:08:59 grommit Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
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.6 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\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)
} @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
#
}
#
# 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/
#
# 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/
#
# 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/
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"
=item *
-Support options and extra attributes.
+Support options attribute.
=item *