Improve trigger 'scope' attribute support (RT#119997)

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / XML / SQLFairy.pm

diff --git a/lib/SQL/Translator/Producer/XML/SQLFairy.pm b/lib/SQL/Translator/Producer/XML/SQLFairy.pm
index 34335f8..ce9e151 100644 (file)
--- a/lib/SQL/Translator/Producer/XML/SQLFairy.pm
+++ b/lib/SQL/Translator/Producer/XML/SQLFairy.pm
@@ -1,28 +1,5 @@
 package SQL::Translator::Producer::XML::SQLFairy;
 
-# -------------------------------------------------------------------
-# $Id: SQLFairy.pm 1440 2009-01-17 16:31:57Z jawnsy $
-# -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
-#                    darren chamberlain <darren@cpan.org>,
-#                    Chris Mungall <cjm@fruitfly.org>,
-#                    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
-# -------------------------------------------------------------------
-
 =pod
 
 =head1 NAME
@@ -58,12 +35,12 @@ the tag, except for sql, comments and action, which get mapped to child data
 elements.
 
 List valued attributes (such as the list of fields in an index)
-get mapped to comma seperated lists of values in the attribute.
+get mapped to comma separated lists of values in the attribute.
 
 Child objects, such as a tables fields, get mapped to child tags wrapped in a
 set of container tags using the plural of their contained classes name.
 
-An objects's extra attribute (a hash of arbitary data) is
+An objects' extra attribute (a hash of arbitrary data) is
 mapped to a tag called extra, with the hash of data as attributes, sorted into
 alphabetical order.
 
@@ -149,7 +126,7 @@ Default is 2, set to 0 to turn off indenting.
 
 =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. The old producer could produce attribute only or data element
 only versions. While this allowed for lots of flexibility in writing the XML
@@ -164,13 +141,14 @@ To convert your old format files simply pass them through the translator :)
 =cut
 
 use strict;
-use vars qw[ @EXPORT_OK ];
+use warnings;
+our @EXPORT_OK;
+our $VERSION = '1.59';
 
 use Exporter;
 use base qw(Exporter);
 @EXPORT_OK = qw(produce);
 
-use IO::Scalar;
 use SQL::Translator::Utils qw(header_comment debug);
 BEGIN {
     # Will someone fix XML::Writer already?
@@ -188,21 +166,23 @@ my @MAP_AS_ELEMENTS = qw/sql comments action extra/;
 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
 my $Name      = 'sqlf';
 my $PArgs     = {};
+my $no_comments;
 
 sub produce {
     my $translator  = shift;
     my $schema      = $translator->schema;
+    $no_comments    = $translator->no_comments;
     $PArgs          = $translator->producer_args;
     my $newlines    = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1;
     my $indent      = defined $PArgs->{indent}   ? $PArgs->{indent}   : 2;
-    my $io          = IO::Scalar->new;
 
     # Setup the XML::Writer and set the namespace
+    my $io;
     my $prefix = "";
     $prefix    = $Name            if $PArgs->{add_prefix};
     $prefix    = $PArgs->{prefix} if $PArgs->{prefix};
     my $xml         = XML::Writer->new(
-        OUTPUT      => $io,
+        OUTPUT      => \$io,
         NAMESPACES  => 1,
         PREFIX_MAP  => { $Namespace => $prefix },
         DATA_MODE   => $newlines,
@@ -211,7 +191,10 @@ sub produce {
 
     # Start the document
     $xml->xmlDecl('UTF-8');
-    $xml->comment(header_comment('', ''));
+
+    $xml->comment(header_comment('', ''))
+      unless $no_comments;
+
     xml_obj($xml, $schema,
         tag => "schema", methods => [qw/name database extra/], end_tag => 0 );
 
@@ -287,8 +270,8 @@ sub produce {
     #
     xml_obj_children( $xml, $schema,
         tag    => 'trigger',
-        methods => [qw/name database_event action on_table perform_action_when
-            fields order extra/],
+        methods => [qw/name database_events action on_table perform_action_when
+            fields order extra scope/],
     );
 
     #
@@ -347,7 +330,7 @@ sub xml_obj_children {
 
 #
 # Takes an XML::Writer, Schema::* object and list of method names
-# and writes the obect out as XML. All methods values are written as attributes
+# and writes the object out as XML. All methods values are written as attributes
 # except for the methods listed in @MAP_AS_ELEMENTS which get written as child
 # data elements.
 #
@@ -367,7 +350,7 @@ sub xml_obj {
     my @meths              = @{ $args{'methods'} };
     my $empty_tag          = 0;
 
-    # Use array to ensure consistant (ie not hash) ordering of attribs
+    # Use array to ensure consistent (ie not hash) ordering of attribs
     # The order comes from the meths list passed in.
     my @tags;
     my @attr;
@@ -407,13 +390,13 @@ sub xml_obj {
 
 =head1 AUTHORS
 
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
 
 =head1 SEE ALSO
 
-L<perl(1)>, L<SQL::Translator>, L<SQL::Translator::Parser::XML::SQLFairy>,
+C<perl(1)>, L<SQL::Translator>, L<SQL::Translator::Parser::XML::SQLFairy>,
 L<SQL::Translator::Schema>, L<XML::Writer>.
 
 =cut