lib/SQL/Translator/Parser/XML/SQLFairy.pm

   1 package SQL::Translator::Parser::XML::SQLFairy;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: SQLFairy.pm,v 1.2 2003-08-22 19:11:09 kycl4rk 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::XML::SQLFairy - parser for SQL::Translator's XML
  26
  27 =head1 SYNOPSIS
  28
  29   use SQL::Translator;
  30   use SQL::Translator::Parser::XML::SQLFairy;
  31
  32   my $translator     = SQL::Translator->new(
  33       from           => 'XML-SQLFairy',
  34       to             => 'MySQL',
  35       filename       => 'schema.xml',
  36       show_warnings  => 1,
  37       add_drop_table => 1,
  38   );
  39
  40   print $obj->translate;
  41
  42 =head1 DESCRIPTION
  43
  44 This parser handles the flavor of XML used natively by the SQLFairy
  45 project (SQL::Translator).  The XML must be in the namespace
  46 "http://sqlfairy.sourceforge.net/sqlfairy.xml."
  47
  48 To see an example of the XML translate one of your schema :) e.g.
  49
  50   $ sql_translator.pl -f MySQL -t XML-SQLFairy schema.sql
  51
  52 =head2 attrib_values
  53
  54 The parser will happily parse XML produced with the attrib_values arg
  55 set. If it sees a value set as an attribute and a tag, the tag value
  56 will override that of the attribute.
  57
  58 e.g. For the xml below the table would get the name 'bar'.
  59
  60   <sqlf:table name="foo">
  61     <sqlf:name>foo</name>
  62   </sqlf:table>
  63
  64 =head2 default_value
  65
  66 Leave the tag out all together to use the default in Schema::Field.
  67 Use empty tags or EMPTY_STRING for a zero lenth string. NULL for an
  68 explicit null (currently sets default_value to undef in the
  69 Schema::Field obj).
  70
  71   <sqlf:default_value></sqlf:default_value>             <!-- Empty string -->
  72   <sqlf:default_value>EMPTY_STRING</sqlf:default_value> <!-- Empty string -->
  73   <sqlf:default_value>NULL</sqlf:default_value>         <!-- NULL -->
  74
  75   <sqlf:default_value/> <!-- Empty string BUT DON'T USE! See BUGS -->
  76
  77 =head2 ARGS
  78
  79 Doesn't take any extra parser args at the moment.
  80
  81 =cut
  82
  83 # -------------------------------------------------------------------
  84
  85 use strict;
  86
  87 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  88 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
  89 $DEBUG   = 0 unless defined $DEBUG;
  90
  91 use Data::Dumper;
  92 use Exporter;
  93 use base qw(Exporter);
  94 @EXPORT_OK = qw(parse);
  95
  96 use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
  97 use SQL::Translator::Utils 'debug';
  98 use XML::XPath;
  99 use XML::XPath::XMLParser;
 100
 101 sub parse {
 102     my ( $translator, $data ) = @_;
 103     my $schema                = $translator->schema;
 104     local $DEBUG              = $translator->debug;
 105     my $xp                    = XML::XPath->new(xml => $data);
 106
 107     $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
 108
 109     #
 110     # Work our way through the tables
 111     #
 112     my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
 113     for my $tblnode (
 114         sort {
 115             "".$xp->findvalue('sqlf:order',$a)
 116             <=>
 117             "".$xp->findvalue('sqlf:order',$b)
 118         } @nodes
 119     ) {
 120         debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
 121
 122         my $table = $schema->add_table(
 123             get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
 124         ) or die $schema->error;
 125
 126         #
 127         # Fields
 128         #
 129         my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
 130         foreach (
 131             sort {
 132                 ("".$xp->findvalue('sqlf:order',$a) || 0)
 133                 <=>
 134                 ("".$xp->findvalue('sqlf:order',$b) || 0)
 135             } @nodes
 136         ) {
 137             my %fdata = get_tagfields($xp, $_, "sqlf:",
 138                 qw/name data_type size default_value is_nullable
 139                 is_auto_increment is_primary_key is_foreign_key comments/
 140             );
 141
 142             if (
 143                 exists $fdata{'default_value'} and
 144                 defined $fdata{'default_value'}
 145             ) {
 146                 if ( $fdata{'default_value'} =~ /^\s*NULL\s*$/ ) {
 147                     $fdata{'default_value'}= undef;
 148                 }
 149                 elsif ( $fdata{'default_value'} =~ /^\s*EMPTY_STRING\s*$/ ) {
 150                     $fdata{'default_value'} = "";
 151                 }
 152             }
 153
 154             my $field = $table->add_field( %fdata ) or die $schema->error;
 155
 156             $table->primary_key( $field->name ) if $fdata{'is_primary_key'};
 157
 158             #
 159             # TODO:
 160             # - We should be able to make the table obj spot this when
 161             #   we use add_field.
 162             # - Deal with $field->extra
 163             #
 164         }
 165
 166         #
 167         # Constraints
 168         #
 169         @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
 170         foreach (@nodes) {
 171             my %data = get_tagfields($xp, $_, "sqlf:",
 172                 qw/name type table fields reference_fields reference_table
 173                 match_type on_delete_do on_update_do/
 174             );
 175             $table->add_constraint( %data ) or die $schema->error;
 176         }
 177
 178         #
 179         # Indexes
 180         #
 181         @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
 182         foreach (@nodes) {
 183             my %data = get_tagfields($xp, $_, "sqlf:",
 184                 qw/name type fields options/);
 185             $table->add_index( %data ) or die $schema->error;
 186         }
 187
 188     } # tables loop
 189
 190     return 1;
 191 }
 192
 193 # -------------------------------------------------------------------
 194 sub get_tagfields {
 195 #
 196 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
 197 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
 198 #
 199 # Returns hash of data. If a tag isn't in the file it is not in this
 200 # hash.
 201 # TODO Add handling of and explicit NULL value.
 202 #
 203
 204     my ($xp, $node, @names) = @_;
 205     my (%data, $ns);
 206     foreach (@names) {
 207         if ( m/:$/ ) { $ns = $_; next; }  # Set def namespace
 208         my $thisns = (s/(^.*?:)// ? $1 : $ns);
 209
 210         foreach my $path ( "\@$thisns$_", "$thisns$_" ) {
 211             $data{ $_ } = $xp->findvalue( $path, $node )
 212                 if $xp->exists( $path, $node );
 213
 214             debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
 215         }
 216     }
 217
 218     return wantarray ? %data : \%data;
 219 }
 220
 221 1;
 222
 223 # -------------------------------------------------------------------
 224
 225 =pod
 226
 227 =head1 BUGS
 228
 229 B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and
 230 hence also false.  This is a bit counter intuative for some tags as
 231 seeing <sqlf:is_nullable /> you might think that it was set when it
 232 fact it wouldn't be.  So for now it is safest not to use them until
 233 their handling by the parser is defined.
 234
 235 =head1 TODO
 236
 237 =over 4
 238
 239 =item *
 240
 241 Support sqf:options.
 242
 243 =item *
 244
 245 Test forign keys are parsed ok.
 246
 247 =item *
 248
 249 Sort out sane handling of empty tags <foo/> vs tags with no content
 250 <foo></foo> vs it no tag being there.
 251
 252 =item *
 253
 254 Control over defaulting of non-existant tags.
 255
 256 =back
 257
 258 =head1 AUTHOR
 259
 260 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
 261
 262 =head1 SEE ALSO
 263
 264 perl(1), SQL::Translator, SQL::Translator::Producer::XML::SQLFairy,
 265 SQL::Translator::Schema.
 266
 267 =cut