package SQL::Translator::Parser::XML::SQLFairy;
# -------------------------------------------------------------------
-# $Id: SQLFairy.pm,v 1.1 2003-08-22 18:01:50 kycl4rk Exp $
+# $Id: SQLFairy.pm,v 1.2 2003-08-22 19:11:09 kycl4rk Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
=head2 attrib_values
-The parser will happily parse XML produced with the attrib_values arg set. If
-it sees a value set as an attribute and a tag, the tag value will override
-that of the attribute.
+The parser will happily parse XML produced with the attrib_values arg
+set. If it sees a value set as an attribute and a tag, the tag value
+will override that of the attribute.
e.g. For the xml below the table would get the name 'bar'.
=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).
+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>NULL</sqlf:default_value> <!-- NULL -->
+ <sqlf:default_value></sqlf:default_value> <!-- Empty string -->
+ <sqlf:default_value>EMPTY_STRING</sqlf:default_value> <!-- Empty string -->
+ <sqlf:default_value>NULL</sqlf:default_value> <!-- NULL -->
- <sqlf:default_value/> <!-- Empty string BUT DON'T USE! See BUGS -->
+ <sqlf:default_value/> <!-- Empty string BUT DON'T USE! See BUGS -->
=head2 ARGS
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
@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 debug {
- warn @_,"\n" if $DEBUG;
-}
-
sub parse {
my ( $translator, $data ) = @_;
- my $schema = $translator->schema;
- local $DEBUG = $translator->debug;
- #local $TRACE = $translator->trace ? 1 : undef;
- # Nothing with trace option yet!
+ my $schema = $translator->schema;
+ local $DEBUG = $translator->debug;
+ my $xp = XML::XPath->new(xml => $data);
- 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',$a)
- <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
+ sort {
+ "".$xp->findvalue('sqlf:order',$a)
+ <=>
+ "".$xp->findvalue('sqlf: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
+ 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;
+ 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} = "";
+ elsif ( $fdata{'default_value'} =~ /^\s*EMPTY_STRING\s*$/ ) {
+ $fdata{'default_value'} = "";
}
}
- my $field = $table->add_field(%fdata) or die $schema->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.
- # TODO Deal with $field->extra
+
+ my $field = $table->add_field( %fdata ) or die $schema->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 $schema->error;
+ qw/name type table fields reference_fields reference_table
+ match_type on_delete_do on_update_do/
+ );
+ $table->add_constraint( %data ) or die $schema->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 $schema->error;
+ qw/name type fields options/);
+ $table->add_index( %data ) or die $schema->error;
}
} # tables loop
return 1;
}
+# -------------------------------------------------------------------
+sub get_tagfields {
+#
# get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
# get_tagfields $node, "sqlf:" => qw/name type fields reference/;
#
# Returns hash of data. If a tag isn't in the file it is not in this
# hash.
# TODO Add handling of and explicit NULL value.
-sub get_tagfields {
+#
+
my ($xp, $node, @names) = @_;
my (%data, $ns);
foreach (@names) {
if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
my $thisns = (s/(^.*?:)// ? $1 : $ns);
- foreach my $path ( "\@$thisns$_","$thisns$_") {
- $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node);
- debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF");
+
+ foreach my $path ( "\@$thisns$_", "$thisns$_" ) {
+ $data{ $_ } = $xp->findvalue( $path, $node )
+ if $xp->exists( $path, $node );
+
+ debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
}
}
+
return wantarray ? %data : \%data;
}
=over 4
-=item * Support sqf:options.
+=item *
+
+Support sqf:options.
+
+=item *
+
+Test forign keys are parsed ok.
+
+=item *
-=item * Test forign keys are parsed ok.
+Sort out sane handling of empty tags <foo/> vs tags with no content
+<foo></foo> vs it no tag being there.
-=item * Sort out sane handling of empty tags <foo/> vs tags with no content
- <foo></foo> vs it no tag being there.
+=item *
-=item * Control over defaulting of non-existant tags.
+Control over defaulting of non-existant tags.
=back
projects / dbsrgits/SQL-Translator.git / commitdiff