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

   1 package SQL::Translator::Parser::XML::SQLFairy;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: SQLFairy.pm,v 1.10 2004-08-19 20:41:31 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 (L<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 attribute out all together to use the default in L<Schema::Field>.
  68 Use empty quotes 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:field default_value="" />                <!-- Empty string -->
  73   <sqlf:field default_value="EMPTY_STRING" />    <!-- Empty string -->
  74   <sqlf:field default_value="NULL" />            <!-- NULL -->
  75
  76 =head2 ARGS
  77
  78 Doesn't take any extra parser args at the moment.
  79
  80 =head1 LEGACY FORMAT
  81
  82 The previous version of the SQLFairy XML allowed the attributes of the the
  83 schema objects to be written as either xml attributes or as data elements, in
  84 any combination. While this allows for lots of flexibility in writing the XML
  85 the result is a great many possible XML formats, not so good for DTD writing,
  86 XPathing etc! So we have moved to a fixed version described in
  87 L<SQL::Translator::Producer::XML::SQLFairy>.
  88
  89 This version of the parser will still parse the old formats and emmit warnings
  90 when it sees them being used but they should be considered B<heavily
  91 depreciated>.
  92
  93 To convert your old format files simply pass them through the translator :)
  94
  95  $ sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml
  96
  97 =cut
  98
  99 # -------------------------------------------------------------------
 100
 101 use strict;
 102
 103 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
 104 $VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
 105 $DEBUG   = 0 unless defined $DEBUG;
 106
 107 use Data::Dumper;
 108 use Exporter;
 109 use base qw(Exporter);
 110 @EXPORT_OK = qw(parse);
 111
 112 use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
 113 use SQL::Translator::Utils 'debug';
 114 use XML::XPath;
 115 use XML::XPath::XMLParser;
 116
 117 sub parse {
 118     my ( $translator, $data ) = @_;
 119     my $schema                = $translator->schema;
 120     local $DEBUG              = $translator->debug;
 121     my $xp                    = XML::XPath->new(xml => $data);
 122
 123     $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
 124
 125     #
 126     # Work our way through the tables
 127     #
 128     my @nodes = $xp->findnodes(
 129         '/sqlf:schema/sqlf:table|/sqlf:schema/sqlf:tables/sqlf:table'
 130     );
 131     for my $tblnode (
 132         sort {
 133             "".$xp->findvalue('sqlf:order|@order',$a)
 134             <=>
 135             "".$xp->findvalue('sqlf:order|@order',$b)
 136         } @nodes
 137     ) {
 138         debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
 139
 140         my $table = $schema->add_table(
 141             get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
 142         ) or die $schema->error;
 143
 144         #
 145         # Fields
 146         #
 147         my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
 148         foreach (
 149             sort {
 150                 ("".$xp->findvalue('sqlf:order',$a) || 0)
 151                 <=>
 152                 ("".$xp->findvalue('sqlf:order',$b) || 0)
 153             } @nodes
 154         ) {
 155             my %fdata = get_tagfields($xp, $_, "sqlf:",
 156                 qw/name data_type size default_value is_nullable extra
 157                 is_auto_increment is_primary_key is_foreign_key comments/
 158             );
 159
 160             if (
 161                 exists $fdata{'default_value'} and
 162                 defined $fdata{'default_value'}
 163             ) {
 164                 if ( $fdata{'default_value'} =~ /^\s*NULL\s*$/ ) {
 165                     $fdata{'default_value'}= undef;
 166                 }
 167                 elsif ( $fdata{'default_value'} =~ /^\s*EMPTY_STRING\s*$/ ) {
 168                     $fdata{'default_value'} = "";
 169                 }
 170             }
 171
 172             my $field = $table->add_field( %fdata ) or die $table->error;
 173
 174             $table->primary_key( $field->name ) if $fdata{'is_primary_key'};
 175
 176             #
 177             # TODO:
 178             # - We should be able to make the table obj spot this when
 179             #   we use add_field.
 180             #
 181         }
 182
 183         #
 184         # Constraints
 185         #
 186         @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
 187         foreach (@nodes) {
 188             my %data = get_tagfields($xp, $_, "sqlf:",
 189                 qw/name type table fields reference_fields reference_table
 190                 match_type on_delete_do on_update_do/
 191             );
 192             $table->add_constraint( %data ) or die $table->error;
 193         }
 194
 195         #
 196         # Indexes
 197         #
 198         @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
 199         foreach (@nodes) {
 200             my %data = get_tagfields($xp, $_, "sqlf:",
 201                 qw/name type fields options/);
 202             $table->add_index( %data ) or die $table->error;
 203         }
 204
 205     } # tables loop
 206
 207     #
 208     # Views
 209     #
 210     @nodes = $xp->findnodes(
 211         '/sqlf:schema/sqlf:view|/sqlf:schema/sqlf:views/sqlf:view'
 212     );
 213     foreach (@nodes) {
 214         my %data = get_tagfields($xp, $_, "sqlf:",
 215             qw/name sql fields order/
 216         );
 217         $schema->add_view( %data ) or die $schema->error;
 218     }
 219
 220     #
 221     # Triggers
 222     #
 223     @nodes = $xp->findnodes(
 224         '/sqlf:schema/sqlf:trigger|/sqlf:schema/sqlf:triggers/sqlf:trigger'
 225     );
 226     foreach (@nodes) {
 227         my %data = get_tagfields($xp, $_, "sqlf:",
 228         qw/name perform_action_when database_event fields on_table action order/
 229         );
 230         $schema->add_trigger( %data ) or die $schema->error;
 231     }
 232
 233     #
 234     # Procedures
 235     #
 236     @nodes = $xp->findnodes(
 237        '/sqlf:schema/sqlf:procedure|/sqlf:schema/sqlf:procedures/sqlf:procedure'
 238     );
 239     foreach (@nodes) {
 240         my %data = get_tagfields($xp, $_, "sqlf:",
 241         qw/name sql parameters owner comments order/
 242         );
 243         $schema->add_procedure( %data ) or die $schema->error;
 244     }
 245
 246     return 1;
 247 }
 248
 249 # -------------------------------------------------------------------
 250 sub get_tagfields {
 251 #
 252 # get_tagfields XP, NODE, NAMESPACE => qw/TAGNAMES/;
 253 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
 254 #
 255 # Returns hash of data.
 256 # TODO - Add handling of an explicit NULL value.
 257 #
 258
 259     my ($xp, $node, @names) = @_;
 260     my (%data, $ns);
 261     foreach (@names) {
 262         if ( m/:$/ ) { $ns = $_; next; }  # Set def namespace
 263         my $thisns = (s/(^.*?:)// ? $1 : $ns);
 264
 265         my $is_attrib = m/^(sql|comments|action|extra)$/ ? 0 : 1;
 266
 267         my $attrib_path = "\@$thisns$_";
 268         my $tag_path    = "$thisns$_";
 269         if ( $xp->exists($attrib_path,$node) ) {
 270             $data{$_} = "".$xp->findvalue($attrib_path,$node);
 271             warn "Use of '$_' as an attribute is depricated."
 272                 ." Use a child tag instead."
 273                 ." To convert your file to the new version see the Docs.\n"
 274                 unless $is_attrib;
 275             debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
 276         }
 277         elsif ( $xp->exists($tag_path,$node) ) {
 278             if ($_ eq "extra") {
 279                 my %extra;
 280                 my $extra_nodes = $xp->find($tag_path,$node);
 281                 foreach ( $extra_nodes->pop->getAttributes ) {
 282                     $extra{$_->getName} = $_->getData;
 283                 }
 284                 $data{$_} = \%extra;
 285             }
 286             else {
 287                 $data{$_} = "".$xp->findvalue($tag_path,$node);
 288             }
 289             warn "Use of '$_' as a child tag is depricated."
 290                 ." Use an attribute instead."
 291                 ." To convert your file to the new version see the Docs.\n"
 292                 if $is_attrib;
 293             debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
 294         }
 295     }
 296
 297     return wantarray ? %data : \%data;
 298 }
 299
 300 1;
 301
 302 # -------------------------------------------------------------------
 303
 304 =pod
 305
 306 =head1 BUGS
 307
 308 Ignores the order attribute for Constraints, Views, Indices,
 309 Views, Triggers and Procedures, using the tag order instead. (This is the order
 310 output by the SQLFairy XML producer).
 311
 312 =head1 SEE ALSO
 313
 314 L<perl>, L<SQL::Translator>, L<SQL::Translator::Producer::XML::SQLFairy>,
 315 L<SQL::Translator::Schema>.
 316
 317 =head1 TODO
 318
 319 =over 4
 320
 321 =item *
 322
 323 Support options attribute.
 324
 325 =item *
 326
 327 Test foreign keys are parsed ok.
 328
 329 =item *
 330
 331 Control over defaulting.
 332
 333 =back
 334
 335 =head1 AUTHOR
 336
 337 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
 338
 339 =cut