package SQL::Translator::Parser::SqlfXML;
# -------------------------------------------------------------------
-# $Id: SqlfXML.pm,v 1.4 2003-08-07 15:03:30 grommit Exp $
+# $Id: SqlfXML.pm,v 1.5 2003-08-15 15:08:08 grommit Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
A SQL Translator parser to parse the XML files produced by its SqftXML producer.
The XML must be in the namespace http://sqlfairy.sourceforge.net/sqlfairy.xml.
-To see and example of the XML translate one of your schema :) e.g.
+To see an example of the XML translate one of your schema :) e.g.
- $ sql_translator.pl --from MySQL --to SqftXML foo_schema.sql
+ $ sql_translator.pl --from=MySQL --to=SqftXML foo_schema.sql
-==head1 default_value
+==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.
+
+e.g. For the xml below the table would get the name 'bar'.
+
+ <sqlf:table name="foo">
+ <sqlf:name>foo</name>
+ </sqlf:table>
+
+==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 Schema::Field).
+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/> <!-- Empty string BUT DON'T USE! See BUGS -->
-
+
+==head2 ARGS
+
+Doesn't take any extra parser args at the moment.
+
=cut
use strict;
use warnings;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
#
my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
foreach (
- sort { "".$xp->findvalue('sqlf:order',$a)
- <=> "".$xp->findvalue('sqlf:order',$b) } @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
my (%data, $ns);
foreach (@names) {
if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
- my $path = (s/(^.*?:)// ? $1 : $ns).$_;
- $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node);
- debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF");
+ 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");
+ }
}
return wantarray ? %data : \%data;
}
=head1 BUGS
B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and hence also
-false. This is a bit counter intuative for some tags as seeing
-<sqlf:is_nullable /> you might think that it was set when it fact it wouldn't
+false. This is a bit counter intuative for some tags as seeing
+<sqlf:is_nullable /> you might think that it was set when it fact it wouldn't
be. So for now it is safest not to use them until their handling by the parser
is defined.
* Support sqf:options.
* Test forign keys are parsed ok.
- * Sort out sane handling of empty tags <foo/> vs tags with no content
+ * Sort out sane handling of empty tags <foo/> vs tags with no content
<foo></foo> vs it no tag being there.
* Control over defaulting of non-existant tags.
our %ATTRIBUTES;
$ATTRIBUTES{field} = [qw/
name
-order
data_type
default_value
size
# Testing 1,2,3,4...
#=============================================================================
-plan tests => 89;
+plan tests => 162;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
-# Parse the test XML schema
-our $obj;
-$obj = SQL::Translator->new(
- debug => DEBUG,
- show_warnings => 1,
- add_drop_table => 1,
-);
-my $testschema = "$Bin/data/xml/schema-basic.xml";
-die "Can't find test schema $testschema" unless -e $testschema;
-my $sql = $obj->translate(
- from => "SqlfXML",
- to =>"MySQL",
- filename => $testschema,
-);
-print $sql if DEBUG;
-#print "Debug:", Dumper($obj) if DEBUG;
-
-# Test the schema objs generted from the XML
-#
-my $scma = $obj->schema;
-my @tblnames = map {$_->name} $scma->get_tables;
-is_deeply( \@tblnames, [qw/Basic/], "tables");
-
-# Basic
-my $tbl = $scma->get_table("Basic");
-is $tbl->order, 1, "Basic->order";
-is_deeply( [map {$_->name} $tbl->get_fields], [qw/
- id title description email explicitnulldef explicitemptystring emptytagdef
-/] , "Table Basic's fields");
-test_field($tbl->get_field("id"),{
- name => "id",
- order => 1,
- data_type => "int",
- default_value => undef,
- is_nullable => 0,
- size => 10,
- is_primary_key => 1,
- is_auto_increment => 1,
-});
-test_field($tbl->get_field("title"),{
- name => "title",
- order => 2,
- data_type => "varchar",
- is_nullable => 0,
- default_value => "hello",
- size => 100,
-});
-test_field($tbl->get_field("description"),{
- name => "description",
- order => 3,
- data_type => "text",
- is_nullable => 1,
- default_value => "",
-});
-test_field($tbl->get_field("email"),{
- name => "email",
- order => 4,
- data_type => "varchar",
- size => 255,
- is_unique => 1,
- default_value => undef,
- is_nullable => 1,
-});
-test_field($tbl->get_field("explicitnulldef"),{
- name => "explicitnulldef",
- order => 5,
- data_type => "varchar",
- default_value => undef,
- is_nullable => 1,
-});
-test_field($tbl->get_field("explicitemptystring"),{
- name => "explicitemptystring",
- order => 6,
- data_type => "varchar",
- default_value => "",
- is_nullable => 1,
-});
-test_field($tbl->get_field("emptytagdef"),{
- name => "emptytagdef",
- order => 7,
- data_type => "varchar",
- default_value => "",
- is_nullable => 1,
-});
-
-my @indices = $tbl->get_indices;
-is scalar(@indices), 1, "Table basic has 1 index";
-
-my @constraints = $tbl->get_constraints;
-is scalar(@constraints), 2, "Table basic has 2 constraints";
-my $con = shift @constraints;
-is $con->table, $tbl, "Constaints table right";
-is $con->name, "", "Constaints table right";
-is $con->type, PRIMARY_KEY, "Constaint is primary key";
-is_deeply [$con->fields], ["id"], "Constaint fields";
-$con = shift @constraints;
-is $con->table, $tbl, "Constaints table right";
-is $con->type, UNIQUE, "Constaint UNIQUE";
-is_deeply [$con->fields], ["email"], "Constaint fields";
+foreach (
+ "$Bin/data/xml/schema-basic.xml",
+ "$Bin/data/xml/schema-basic-attribs.xml"
+) {
+ do_file($_);
+}
+
+sub do_file {
+ my $testschema = shift;
+ # Parse the test XML schema
+ our $obj;
+ $obj = SQL::Translator->new(
+ debug => DEBUG,
+ show_warnings => 1,
+ add_drop_table => 1,
+ );
+ die "Can't find test schema $testschema" unless -e $testschema;
+ my $sql = $obj->translate(
+ from => "SqlfXML",
+ to =>"MySQL",
+ filename => $testschema,
+ );
+ print $sql if DEBUG;
+ #print "Debug:", Dumper($obj) if DEBUG;
+
+ # Test the schema objs generted from the XML
+ #
+ my $scma = $obj->schema;
+ my @tblnames = map {$_->name} $scma->get_tables;
+ is_deeply( \@tblnames, [qw/Basic/], "tables");
+
+ # Basic
+ my $tbl = $scma->get_table("Basic");
+ is_deeply( [map {$_->name} $tbl->get_fields], [qw/
+ id title description email explicitnulldef explicitemptystring emptytagdef
+ /] , "Table Basic's fields");
+ test_field($tbl->get_field("id"),{
+ name => "id",
+ data_type => "int",
+ default_value => undef,
+ is_nullable => 0,
+ size => 10,
+ is_primary_key => 1,
+ is_auto_increment => 1,
+ });
+ test_field($tbl->get_field("title"),{
+ name => "title",
+ data_type => "varchar",
+ is_nullable => 0,
+ default_value => "hello",
+ size => 100,
+ });
+ test_field($tbl->get_field("description"),{
+ name => "description",
+ data_type => "text",
+ is_nullable => 1,
+ default_value => "",
+ });
+ test_field($tbl->get_field("email"),{
+ name => "email",
+ data_type => "varchar",
+ size => 255,
+ is_unique => 1,
+ default_value => undef,
+ is_nullable => 1,
+ });
+ test_field($tbl->get_field("explicitnulldef"),{
+ name => "explicitnulldef",
+ data_type => "varchar",
+ default_value => undef,
+ is_nullable => 1,
+ });
+ test_field($tbl->get_field("explicitemptystring"),{
+ name => "explicitemptystring",
+ data_type => "varchar",
+ default_value => "",
+ is_nullable => 1,
+ });
+ test_field($tbl->get_field("emptytagdef"),{
+ name => "emptytagdef",
+ data_type => "varchar",
+ default_value => "",
+ is_nullable => 1,
+ });
+
+ my @indices = $tbl->get_indices;
+ is scalar(@indices), 1, "Table basic has 1 index";
+
+ my @constraints = $tbl->get_constraints;
+ is scalar(@constraints), 2, "Table basic has 2 constraints";
+ my $con = shift @constraints;
+ is $con->table, $tbl, "Constaints table right";
+ is $con->name, "", "Constaints table right";
+ is $con->type, PRIMARY_KEY, "Constaint is primary key";
+ is_deeply [$con->fields], ["id"], "Constaint fields";
+ $con = shift @constraints;
+ is $con->table, $tbl, "Constaints table right";
+ is $con->type, UNIQUE, "Constaint UNIQUE";
+ is_deeply [$con->fields], ["email"], "Constaint fields";
+} # /Test of schema
projects / dbsrgits/SQL-Translator.git / commitdiff