Improve trigger 'scope' attribute support (RT#119997)
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / XML / SQLFairy.pm
index e6a00a9..14d98b1 100644 (file)
@@ -1,25 +1,5 @@
 package SQL::Translator::Parser::XML::SQLFairy;
 
-# -------------------------------------------------------------------
-# $Id: SQLFairy.pm 1440 2009-01-17 16:31:57Z jawnsy $
-# -------------------------------------------------------------------
-# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; version 2.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-# 02111-1307  USA
-# -------------------------------------------------------------------
-
 =head1 NAME
 
 SQL::Translator::Parser::XML::SQLFairy - parser for SQL::Translator's XML.
@@ -41,8 +21,8 @@ SQL::Translator::Parser::XML::SQLFairy - parser for SQL::Translator's XML.
 =head1 DESCRIPTION
 
 This parser handles the flavor of XML used natively by the SQLFairy
-project (L<SQL::Translator>).  The XML must be in the namespace
-"http://sqlfairy.sourceforge.net/sqlfairy.xml."
+project (L<SQL::Translator>).  The XML must be in the XML namespace
+C<http://sqlfairy.sourceforge.net/sqlfairy.xml>.
 See L<SQL::Translator::Producer::XML::SQLFairy> for details of this format.
 
 You do not need to specify every attribute of the Schema objects as any missing
@@ -63,10 +43,10 @@ tags then the order the tags appear in the XML will be used.
 
 =head2 default_value
 
-Leave the attribute out all together to use the default in L<Schema::Field>.
-Use empty quotes or 'EMPTY_STRING' for a zero lenth string. 'NULL' for an
-explicit null (currently sets default_value to undef in the
-Schema::Field obj).
+Leave the attribute out all together to use the default in
+L<SQL::Translator::Schema::Field>.  Use empty quotes or 'EMPTY_STRING'
+for a zero length string. 'NULL' for an explicit null (currently sets
+default_value to undef in the field object).
 
   <sqlf:field default_value="" />                <!-- Empty string -->
   <sqlf:field default_value="EMPTY_STRING" />    <!-- Empty string -->
@@ -78,14 +58,14 @@ Doesn't take any extra parser args at the moment.
 
 =head1 LEGACY FORMAT
 
-The previous version of the SQLFairy XML allowed the attributes of the the
+The previous version of the SQLFairy XML allowed the attributes of the
 schema objects to be written as either xml attributes or as data elements, in
 any combination. While this allows for lots of flexibility in writing the XML
 the result is a great many possible XML formats, not so good for DTD writing,
 XPathing etc! So we have moved to a fixed version described in
 L<SQL::Translator::Producer::XML::SQLFairy>.
 
-This version of the parser will still parse the old formats and emmit warnings
+This version of the parser will still parse the old formats and emit warnings
 when it sees them being used but they should be considered B<heavily
 depreciated>.
 
@@ -95,31 +75,32 @@ To convert your old format files simply pass them through the translator :)
 
 =cut
 
-# -------------------------------------------------------------------
-
 use strict;
+use warnings;
 
-use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.99';
+our ( $DEBUG, @EXPORT_OK );
+our $VERSION = '1.59';
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
+use Carp::Clan qw/^SQL::Translator/;
 use Exporter;
 use base qw(Exporter);
 @EXPORT_OK = qw(parse);
 
 use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
 use SQL::Translator::Utils 'debug';
-use XML::XPath;
-use XML::XPath::XMLParser;
+use XML::LibXML;
+use XML::LibXML::XPathContext;
 
 sub parse {
     my ( $translator, $data ) = @_;
     my $schema                = $translator->schema;
     local $DEBUG              = $translator->debug;
-    my $xp                    = XML::XPath->new(xml => $data);
+    my $doc                   = XML::LibXML->new->parse_string($data);
+    my $xp                    = XML::LibXML::XPathContext->new($doc);
 
-    $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
+    $xp->registerNs("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
 
     #
     # Work our way through the tables
@@ -201,7 +182,7 @@ sub parse {
             $table->add_index( %data ) or die $table->error;
         }
 
-        
+
         #
         # Comments
         #
@@ -234,9 +215,26 @@ sub parse {
     );
     foreach (@nodes) {
         my %data = get_tagfields($xp, $_, "sqlf:", qw/
-            name perform_action_when database_event fields on_table action order
-            extra
+            name perform_action_when database_event database_events fields
+            on_table action order extra scope
         /);
+
+        # back compat
+        if (my $evt = $data{database_event} and $translator->{show_warnings}) {
+          carp 'The database_event tag is deprecated - please use ' .
+            'database_events (which can take one or more comma separated ' .
+            'event names)';
+          $data{database_events} = join (', ',
+            $data{database_events} || (),
+            $evt,
+          );
+        }
+
+        # split into arrayref
+        if (my $evts = $data{database_events}) {
+          $data{database_events} = [split (/\s*,\s*/, $evts) ];
+        }
+
         $schema->add_trigger( %data ) or die $schema->error;
     }
 
@@ -256,7 +254,6 @@ sub parse {
     return 1;
 }
 
-# -------------------------------------------------------------------
 sub get_tagfields {
 #
 # get_tagfields XP, NODE, NAMESPACE => qw/TAGNAMES/;
@@ -274,27 +271,26 @@ sub get_tagfields {
 
         my $is_attrib = m/^(sql|comments|action|extra)$/ ? 0 : 1;
 
-        my $attrib_path = "\@$thisns$_";
+        my $attrib_path = "\@$_";
         my $tag_path    = "$thisns$_";
-        if ( $xp->exists($attrib_path,$node) ) {
-            $data{$_} = "".$xp->findvalue($attrib_path,$node);
+        if ( my $found = $xp->find($attrib_path,$node) ) {
+            $data{$_} = "".$found->to_literal;
             warn "Use of '$_' as an attribute is depricated."
                 ." Use a child tag instead."
                 ." To convert your file to the new version see the Docs.\n"
                 unless $is_attrib;
             debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
         }
-        elsif ( $xp->exists($tag_path,$node) ) {
+        elsif ( $found = $xp->find($tag_path,$node) ) {
             if ($_ eq "extra") {
                 my %extra;
-                my $extra_nodes = $xp->find($tag_path,$node);
-                foreach ( $extra_nodes->pop->getAttributes ) {
+                foreach ( $found->pop->getAttributes ) {
                     $extra{$_->getName} = $_->getData;
                 }
                 $data{$_} = \%extra;
             }
             else {
-                $data{$_} = "".$xp->findvalue($tag_path,$node);
+                $data{$_} = "".$found->to_literal;
             }
             warn "Use of '$_' as a child tag is depricated."
                 ." Use an attribute instead."
@@ -309,15 +305,13 @@ sub get_tagfields {
 
 1;
 
-# -------------------------------------------------------------------
-
 =pod
 
 =head1 BUGS
 
-Ignores the order attribute for Constraints, Views, Indices,
-Views, Triggers and Procedures, using the tag order instead. (This is the order
-output by the SQLFairy XML producer).
+Ignores the order attribute for Constraints, Views, Indices, Views, Triggers
+and Procedures, using the tag order instead. (This is the order output by the
+SQLFairy XML producer).
 
 =head1 SEE ALSO
 
@@ -344,6 +338,7 @@ Control over defaulting.
 
 =head1 AUTHOR
 
-Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
+Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
+Jonathan Yu E<lt>frequency@cpan.orgE<gt>
 
 =cut