X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FXML%2FSQLFairy.pm;h=399bc4e840e5e6f383ed23027fb51167866b9dfd;hb=a5e624ac47eee4ed9b275143436304cbd0da09e8;hp=20a0879e8c2e45a7468a1d92ceabe1da988d07f1;hpb=0a1ec87af6bf62f801f03d9ad58d41a4b3a2a4ac;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Parser/XML/SQLFairy.pm b/lib/SQL/Translator/Parser/XML/SQLFairy.pm index 20a0879..399bc4e 100644 --- a/lib/SQL/Translator/Parser/XML/SQLFairy.pm +++ b/lib/SQL/Translator/Parser/XML/SQLFairy.pm @@ -1,7 +1,7 @@ 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 , # @@ -51,9 +51,9 @@ To see an example of the XML translate one of your schema :) e.g. =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'. @@ -63,15 +63,16 @@ 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). - - EMPTY_STRING - NULL + + EMPTY_STRING + NULL - + =head2 ARGS @@ -84,7 +85,7 @@ Doesn't take any extra parser args at the moment. 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; @@ -93,77 +94,95 @@ use base qw(Exporter); @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 @@ -171,23 +190,31 @@ sub parse { 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; } @@ -209,14 +236,22 @@ their handling by the parser is defined. =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 vs tags with no content + vs it no tag being there. -=item * Sort out sane handling of empty tags vs tags with no content - vs it no tag being there. +=item * -=item * Control over defaulting of non-existant tags. +Control over defaulting of non-existant tags. =back