lib/SQL/Translator/Parser/SqlfXML.pm

   1 package SQL::Translator::Parser::SqlfXML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: SqlfXML.pm,v 1.1 2003-08-06 17:14:08 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 =cut
  53
  54 use strict;
  55 use warnings;
  56
  57 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  58 $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
  59 $DEBUG   = 0 unless defined $DEBUG;
  60
  61 use Data::Dumper;
  62 use Exporter;
  63 use base qw(Exporter);
  64 @EXPORT_OK = qw(parse);
  65
  66 use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
  67 use XML::XPath;
  68 use XML::XPath::XMLParser;
  69
  70 sub debug {
  71     warn @_,"\n" if $DEBUG;
  72 }
  73
  74 sub parse {
  75     my ( $translator, $data ) = @_;
  76     my $schema   = $translator->schema;
  77     local $DEBUG = $translator->debug;
  78     #local $TRACE  = $translator->trace ? 1 : undef;
  79     # Nothing with trace option yet!
  80
  81     my $xp = XML::XPath->new(xml => $data);
  82     $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
  83
  84     # Work our way through the tables
  85     #
  86     my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
  87     for my $tblnode (
  88         sort { "".$xp->findvalue('sqlf:order',$a)
  89                <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
  90     ) {
  91         debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
  92         my $table = $schema->add_table(
  93             get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
  94         ) or die $schema->error;
  95
  96         # Fields
  97         #
  98         my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
  99         foreach (
 100             sort { "".$xp->findvalue('sqlf:order',$a)
 101                    <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
 102         ) {
 103             my %fdata = get_tagfields($xp, $_, "sqlf:",
 104             qw/name data_type size default_value is_nullable is_auto_increment
 105                is_primary_key is_foreign_key comments/);
 106             my $field = $table->add_field(%fdata) or die $schema->error;
 107             $table->primary_key($field->name) if $fdata{'is_primary_key'};
 108                 # TODO We should be able to make the table obj spot this when we
 109                 # use add_field.
 110             # TODO Deal with $field->extra
 111         }
 112
 113         # Constraints
 114         #
 115         @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
 116         foreach (@nodes) {
 117             my %data = get_tagfields($xp, $_, "sqlf:",
 118             qw/name type table fields reference_fields reference_table
 119                match_type on_delete_do on_update_do/);
 120             $table->add_constraint(%data) or die $schema->error;
 121         }
 122
 123         # Indexes
 124         #
 125         @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
 126         foreach (@nodes) {
 127             my %data = get_tagfields($xp, $_, "sqlf:",
 128             qw/name type fields options/);
 129             $table->add_index(%data) or die $schema->error;
 130         }
 131
 132     } # tables loop
 133
 134     return 1;
 135 }
 136
 137 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
 138 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
 139 sub get_tagfields {
 140     my ($xp, $node, @names) = @_;
 141     my (%data, $ns);
 142     foreach (@names) {
 143         if ( m/:$/ ) { $ns = $_; next; }  # Set def namespace
 144         $data{$_} = "".$xp->findvalue( (s/(^.*?:)// ? $1 : $ns).$_, $node );
 145     }
 146     return wantarray ? %data : \%data;
 147 }
 148
 149 1;
 150
 151 __END__
 152
 153 =pod
 154
 155 =head1 TODO
 156
 157  * Support sqf:options.
 158  * Test forign keys are parsed ok.
 159  * Control over defaulting and parsing of empty vs non-existant tags.
 160
 161 =head1 AUTHOR
 162
 163 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
 164
 165 =head1 SEE ALSO
 166
 167 perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML,
 168 SQL::Translator::Schema.
 169
 170 =cut