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

   1 package SQL::Translator::Parser::XML::SQLFairy;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: SQLFairy.pm,v 1.6 2004-07-08 19:06:24 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::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 See L<SQL::Translator::Producer::XML::SQLFairy> for details of this format.
  48
  49 You do not need to specify every attribute of the Schema objects as any missing
  50 from the XML will be set to their default values. e.g. A field could be written
  51 using only;
  52
  53  <sqlf:field name="email" data_type="varchar" size="255" />
  54
  55 Instead of the full;
  56
  57  <sqlf:field name="email" data_type="varchar" size="255" is_nullable="1"
  58    is_auto_increment="0" is_primary_key="0" is_foreign_key="0" order="4">
  59    <sqlf:comments></sqlf:comments>
  60  </sqlf:field>
  61
  62 If you do not explicitly set the order of items using order attributes on the
  63 tags then the order the tags appear in the XML will be used.
  64
  65 =head2 default_value
  66
  67 Leave the tag out all together to use the default in Schema::Field.
  68 Use empty tags or 'EMPTY_STRING' for a zero lenth string. 'NULL' for an
  69 explicit null (currently sets default_value to undef in the
  70 Schema::Field obj).
  71
  72   <sqlf:default_value></sqlf:default_value>             <!-- Empty string -->
  73   <sqlf:default_value>EMPTY_STRING</sqlf:default_value> <!-- Empty string -->
  74   <sqlf:default_value/>                                 <!-- Empty string -->
  75   <sqlf:default_value>NULL</sqlf:default_value>         <!-- NULL -->
  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.6 $ =~ /(\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|@order',$a)
 116             <=>
 117             "".$xp->findvalue('sqlf:order|@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 $table->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 $table->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 $table->error;
 186         }
 187
 188     } # tables loop
 189
 190     #
 191     # Views
 192     #
 193     @nodes = $xp->findnodes('/sqlf:schema/sqlf:view');
 194     foreach (@nodes) {
 195         my %data = get_tagfields($xp, $_, "sqlf:",
 196             qw/name sql fields order/
 197         );
 198         $schema->add_view( %data ) or die $schema->error;
 199     }
 200
 201     #
 202     # Triggers
 203     #
 204     @nodes = $xp->findnodes('/sqlf:schema/sqlf:trigger');
 205     foreach (@nodes) {
 206         my %data = get_tagfields($xp, $_, "sqlf:",
 207         qw/name perform_action_when database_event fields on_table action order/
 208         );
 209         $schema->add_trigger( %data ) or die $schema->error;
 210     }
 211
 212     #
 213     # Procedures
 214     #
 215     @nodes = $xp->findnodes('/sqlf:schema/sqlf:procedure');
 216     foreach (@nodes) {
 217         my %data = get_tagfields($xp, $_, "sqlf:",
 218         qw/name sql parameters owner comments order/
 219         );
 220         $schema->add_procedure( %data ) or die $schema->error;
 221     }
 222
 223     return 1;
 224 }
 225
 226 # -------------------------------------------------------------------
 227 sub get_tagfields {
 228 #
 229 # get_tagfields XP, NODE, NAMESPACE => qw/TAGNAMES/;
 230 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
 231 #
 232 # Returns hash of data.
 233 # TODO - Add handling of an explicit NULL value.
 234 #
 235
 236     my ($xp, $node, @names) = @_;
 237     my (%data, $ns);
 238     foreach (@names) {
 239         if ( m/:$/ ) { $ns = $_; next; }  # Set def namespace
 240         my $thisns = (s/(^.*?:)// ? $1 : $ns);
 241
 242         my $is_attrib = m/^sql|comments|action$/ ? 0 : 1;
 243
 244         my $attrib_path = "\@$thisns$_";
 245         my $tag_path    = "$thisns$_";
 246         if ( $xp->exists($attrib_path,$node) ) {
 247             $data{$_} = "".$xp->findvalue($attrib_path,$node);
 248             warn "Use of '$_' as an attribute is depricated."
 249                 ." Use a child tag instead."
 250                 ." To convert your file to the new version see the Docs.\n"
 251                 unless $is_attrib;
 252             debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
 253         }
 254         elsif ( $xp->exists($tag_path,$node) ) {
 255             $data{$_} = "".$xp->findvalue($tag_path,$node);
 256             warn "Use of '$_' as a child tag is depricated."
 257                 ." Use an attribute instead."
 258                 ." To convert your file to the new version see the Docs.\n"
 259                 if $is_attrib;
 260             debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
 261         }
 262     }
 263
 264     return wantarray ? %data : \%data;
 265 }
 266
 267 1;
 268
 269 # -------------------------------------------------------------------
 270
 271 =pod
 272
 273 =head1 BUGS
 274
 275 Ignores the order attribute for Constraints, Views, Indices,
 276 Views, Triggers and Procedures, using the tag order instead. (This is the order
 277 output by the SQLFairy XML producer).
 278
 279 =head1 TODO
 280
 281 =over 4
 282
 283 =item *
 284
 285 Support options and extra attributes.
 286
 287 =item *
 288
 289 Test foreign keys are parsed ok.
 290
 291 =item *
 292
 293 Control over defaulting of non-existant tags.
 294
 295 =back
 296
 297 =head1 AUTHOR
 298
 299 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
 300
 301 =head1 SEE ALSO
 302
 303 perl(1), SQL::Translator, SQL::Translator::Producer::XML::SQLFairy,
 304 SQL::Translator::Schema.
 305
 306 =cut