package SQL::Translator::Parser::SqlfXML;
# -------------------------------------------------------------------
-# $Id: SqlfXML.pm,v 1.1 2003-08-06 17:14:08 grommit Exp $
+# $Id: SqlfXML.pm,v 1.2 2003-08-06 22:08:16 grommit Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
$ sql_translator.pl --from MySQL --to SqftXML foo_schema.sql
+==head1 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).
+
+ <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 -->
+
=cut
use strict;
use warnings;
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;
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 $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
# 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
- $data{$_} = "".$xp->findvalue( (s/(^.*?:)// ? $1 : $ns).$_, $node );
+ my $path = (s/(^.*?:)// ? $1 : $ns).$_;
+ $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node);
+ debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF");
}
return wantarray ? %data : \%data;
}
* Support sqf:options.
* Test forign keys are parsed ok.
- * Control over defaulting and parsing of empty vs non-existant tags.
+ * Control over defaulting of non-existant tags.
=head1 AUTHOR
# Tests that;
#
-use Test::More qw/no_plan/;
+use Test::More tests => 78;
use Test::Exception;
use strict;
/];
sub test_field {
- my ($fld,$test) = @_;
- die "test_field needs a least a name!" unless $test->{name};
- my $name = $test->{name};
- is $fld->name, $name, "$name - Name right";
-
- foreach my $attr ( @{$ATTRIBUTES{field}} ) {
- if ( defined(my $ans = $test->{$attr}) ) {
- if ( $attr =~ m/^is_/ ) {
- ok $fld->$attr, " $name - $attr true";
- }
- else {
- is $fld->$attr, $ans, " $name - $attr = '$ans'";
- }
- }
- else {
- ok !$fld->$attr, "$name - $attr not set";
- }
- }
+ my ($fld,$test) = @_;
+ die "test_field needs a least a name!" unless $test->{name};
+ my $name = $test->{name};
+ is $fld->name, $name, "$name - Name right";
+
+ foreach my $attr ( @{$ATTRIBUTES{field}} ) {
+ if ( exists $test->{$attr} ) {
+ my $ans = $test->{$attr};
+ if ( $attr =~ m/^is_/ ) {
+ if ($ans) { ok $fld->$attr, " $name - $attr true"; }
+ else { ok !$fld->$attr, " $name - $attr false"; }
+ }
+ else {
+ is $fld->$attr, $ans, " $name - $attr = '"
+ .(defined $ans ? $ans : "NULL" )."'";
+ }
+ }
+ else {
+ ok !$fld->$attr, "$name - $attr not set";
+ }
+ }
}
# TODO test_constraint, test_index
# Parse the test XML schema
our $obj;
$obj = SQL::Translator->new(
- debug => DEBUG,
- show_warnings => 1,
- add_drop_table => 1,
+ 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,
+ from => "SqlfXML",
+ to =>"MySQL",
+ filename => $testschema,
);
-print $sql;
+print $sql if DEBUG;
#print "Debug:", Dumper($obj) if DEBUG;
# Test the schema objs generted from the XML
# 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/]
- , "Table Basic's fields");
+is_deeply( [map {$_->name} $tbl->get_fields],
+ [qw/id title description email explicitnulldef explicitemptystring/] ,
+ "Table Basic's fields");
test_field($tbl->get_field("id"),{
- name => "id",
- order => 1,
- data_type => "int",
- size => 10,
- is_primary_key => 1,
- is_auto_increment => 1,
+ 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",
- default_value => "hello",
- size => 100,
+ 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,
+ 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,
+ 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,
});
my @indices = $tbl->get_indices;
-->
<sqlf:schema xmlns:sqlf="http://sqlfairy.sourceforge.net/sqlfairy.xml">
-
+
<sqlf:table>
<sqlf:name>Basic</sqlf:name>
<sqlf:order>1</sqlf:order>
<sqlf:is_primary_key>1</sqlf:is_primary_key>
<sqlf:is_auto_increment>1</sqlf:is_auto_increment>
<sqlf:data_type>int</sqlf:data_type>
+ <sqlf:is_nullable>0</sqlf:is_nullable>
<sqlf:size>10</sqlf:size>
<sqlf:order>1</sqlf:order>
</sqlf:field>
<sqlf:data_type>varchar</sqlf:data_type>
<sqlf:size>100</sqlf:size>
<sqlf:default_value>hello</sqlf:default_value>
+ <sqlf:is_nullable>0</sqlf:is_nullable>
<sqlf:order>2</sqlf:order>
</sqlf:field>
<sqlf:field>
- <sqlf:name>description</sqlf:name>
+ <sqlf:name>description</sqlf:name>
<sqlf:data_type>text</sqlf:data_type>
- <sqlf:is_nullable>1</sqlf:is_nullable>
+ <sqlf:default_value></sqlf:default_value>
<sqlf:order>3</sqlf:order>
</sqlf:field>
<sqlf:field>
- <sqlf:name>email</sqlf:name>
+ <sqlf:name>email</sqlf:name>
<sqlf:data_type>varchar</sqlf:data_type>
- <sqlf:size>255</sqlf:size>
+ <sqlf:is_nullable>1</sqlf:is_nullable>
+ <sqlf:size>255</sqlf:size>
<sqlf:order>4</sqlf:order>
</sqlf:field>
- </sqlf:fields>
-
- <sqlf:indices>
+ <sqlf:field>
+ <sqlf:name>explicitnulldef</sqlf:name>
+ <sqlf:data_type>varchar</sqlf:data_type>
+ <sqlf:is_nullable>1</sqlf:is_nullable>
+ <sqlf:default_value>NULL</sqlf:default_value>
+ <sqlf:order>5</sqlf:order>
+ </sqlf:field>
+ <sqlf:field>
+ <sqlf:name>explicitemptystring</sqlf:name>
+ <sqlf:data_type>varchar</sqlf:data_type>
+ <sqlf:is_nullable>1</sqlf:is_nullable>
+ <sqlf:default_value>EMPTY_STRING</sqlf:default_value>
+ <sqlf:order>5</sqlf:order>
+ </sqlf:field>
+ </sqlf:fields>
+
+ <sqlf:indices>
<sqlf:index>
- <sqlf:fields>title</sqlf:fields>
+ <sqlf:fields>title</sqlf:fields>
<sqlf:name>titleindex</sqlf:name>
<sqlf:type>NORMAL</sqlf:type>
</sqlf:index>
</sqlf:indices>
-
- <sqlf:constraints>
+
+ <sqlf:constraints>
<sqlf:constraint>
<sqlf:deferrable>1</sqlf:deferrable>
<sqlf:fields>email</sqlf:fields>
projects / dbsrgits/SQL-Translator.git / commitdiff