lib/SQL/Translator/Parser/SqlfXML.pm

   1 package SQL::Translator::Parser::SqlfXML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: SqlfXML.pm,v 1.4 2003-08-07 15:03:30 grommit Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Parser::SqlfXML - parser for the XML produced by
  26 SQL::Translator::Producer::SqlfXML.
  27
  28 =head1 SYNOPSIS
  29
  30   use SQL::Translator;
  31   use SQL::Translator::Parser::SqlfXML;
  32
  33   my $translator = SQL::Translator->new(
  34       show_warnings  => 1,
  35       add_drop_table => 1,
  36   );
  37   print = $obj->translate(
  38       from     => "SqlfXML",
  39       to       =>"MySQL",
  40       filename => "fooschema.xml",
  41   );
  42
  43 =head1 DESCRIPTION
  44
  45 A SQL Translator parser to parse the XML files produced by its SqftXML producer.
  46 The XML must be in the namespace http://sqlfairy.sourceforge.net/sqlfairy.xml.
  47
  48 To see and example of the XML translate one of your schema :) e.g.
  49
  50  $ sql_translator.pl --from MySQL --to SqftXML foo_schema.sql
  51
  52 ==head1 default_value
  53
  54 Leave the tag out all together to use the default in Schema::Field. Use empty
  55 tags or EMPTY_STRING for a zero lenth string. NULL for an explicit null
  56 (currently sets default_value to undef Schema::Field).
  57
  58  <sqlf:default_value></sqlf:default_value>               <!-- Empty string -->
  59  <sqlf:default_value>EMPTY_STRING</sqlf:default_value>   <!-- Empty string -->
  60  <sqlf:default_value>NULL</sqlf:default_value>           <!-- NULL -->
  61
  62  <sqlf:default_value/>            <!-- Empty string BUT DON'T USE! See BUGS -->
  63
  64 =cut
  65
  66 use strict;
  67 use warnings;
  68
  69 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  70 $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
  71 $DEBUG   = 0 unless defined $DEBUG;
  72
  73 use Data::Dumper;
  74 use Exporter;
  75 use base qw(Exporter);
  76 @EXPORT_OK = qw(parse);
  77
  78 use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
  79 use XML::XPath;
  80 use XML::XPath::XMLParser;
  81
  82 sub debug {
  83     warn @_,"\n" if $DEBUG;
  84 }
  85
  86 sub parse {
  87     my ( $translator, $data ) = @_;
  88     my $schema   = $translator->schema;
  89     local $DEBUG = $translator->debug;
  90     #local $TRACE  = $translator->trace ? 1 : undef;
  91     # Nothing with trace option yet!
  92
  93     my $xp = XML::XPath->new(xml => $data);
  94     $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
  95
  96     # Work our way through the tables
  97     #
  98     my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
  99     for my $tblnode (
 100         sort { "".$xp->findvalue('sqlf:order',$a)
 101                <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
 102     ) {
 103         debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
 104         my $table = $schema->add_table(
 105             get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
 106         ) or die $schema->error;
 107
 108         # Fields
 109         #
 110         my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
 111         foreach (
 112             sort { "".$xp->findvalue('sqlf:order',$a)
 113                    <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
 114         ) {
 115             my %fdata = get_tagfields($xp, $_, "sqlf:",
 116             qw/name data_type size default_value is_nullable is_auto_increment
 117                is_primary_key is_foreign_key comments/);
 118             if (exists $fdata{default_value} and defined $fdata{default_value}){
 119                 if ( $fdata{default_value} =~ /^\s*NULL\s*$/ ) {
 120                     $fdata{default_value}= undef;
 121                 }
 122                 elsif ( $fdata{default_value} =~ /^\s*EMPTY_STRING\s*$/ ) {
 123                     $fdata{default_value} = "";
 124                 }
 125             }
 126             my $field = $table->add_field(%fdata) or die $schema->error;
 127             $table->primary_key($field->name) if $fdata{'is_primary_key'};
 128                 # TODO We should be able to make the table obj spot this when we
 129                 # use add_field.
 130             # TODO Deal with $field->extra
 131         }
 132
 133         # Constraints
 134         #
 135         @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
 136         foreach (@nodes) {
 137             my %data = get_tagfields($xp, $_, "sqlf:",
 138             qw/name type table fields reference_fields reference_table
 139                match_type on_delete_do on_update_do/);
 140             $table->add_constraint(%data) or die $schema->error;
 141         }
 142
 143         # Indexes
 144         #
 145         @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
 146         foreach (@nodes) {
 147             my %data = get_tagfields($xp, $_, "sqlf:",
 148             qw/name type fields options/);
 149             $table->add_index(%data) or die $schema->error;
 150         }
 151
 152     } # tables loop
 153
 154     return 1;
 155 }
 156
 157 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
 158 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
 159 #
 160 # Returns hash of data. If a tag isn't in the file it is not in this
 161 # hash.
 162 # TODO Add handling of and explicit NULL value.
 163 sub get_tagfields {
 164     my ($xp, $node, @names) = @_;
 165     my (%data, $ns);
 166     foreach (@names) {
 167         if ( m/:$/ ) { $ns = $_; next; }  # Set def namespace
 168         my $path = (s/(^.*?:)// ? $1 : $ns).$_;
 169         $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node);
 170         debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF");
 171     }
 172     return wantarray ? %data : \%data;
 173 }
 174
 175 1;
 176
 177 __END__
 178
 179 =pod
 180
 181 =head1 BUGS
 182
 183 B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and hence also
 184 false. This is a bit counter intuative for some tags as seeing
 185 <sqlf:is_nullable /> you might think that it was set when it fact it wouldn't
 186 be. So for now it is safest not to use them until their handling by the parser
 187 is defined.
 188
 189 =head1 TODO
 190
 191  * Support sqf:options.
 192  * Test forign keys are parsed ok.
 193  * Sort out sane handling of empty tags <foo/> vs tags with no content
 194    <foo></foo> vs it no tag being there.
 195  * Control over defaulting of non-existant tags.
 196
 197 =head1 AUTHOR
 198
 199 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
 200
 201 =head1 SEE ALSO
 202
 203 perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML,
 204 SQL::Translator::Schema.
 205
 206 =cut