lib/SQL/Translator/Producer/XML.pm

   1 package SQL::Translator::Producer::XML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: XML.pm,v 1.9 2003-06-09 02:01:23 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
   7 #                    darren chamberlain <darren@cpan.org>,
   8 #                    Chris Mungall <cjm@fruitfly.org>
   9 #
  10 # This program is free software; you can redistribute it and/or
  11 # modify it under the terms of the GNU General Public License as
  12 # published by the Free Software Foundation; version 2.
  13 #
  14 # This program is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program; if not, write to the Free Software
  21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  22 # 02111-1307  USA
  23 # -------------------------------------------------------------------
  24
  25 use strict;
  26 use vars qw[ $VERSION ];
  27 $VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
  28
  29 use IO::Scalar;
  30 use SQL::Translator::Utils qw(header_comment);
  31 use XML::Writer;
  32
  33 my $sqlf_ns = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
  34
  35 # -------------------------------------------------------------------
  36 sub produce {
  37     my ( $translator, $data ) = @_;
  38     my $schema                = $translator->schema;
  39     my $args                  = $translator->producer_args;
  40
  41     my $io          = IO::Scalar->new;
  42     my $xml         =  XML::Writer->new(
  43         OUTPUT      => $io,
  44         NAMESPACES  => 1,
  45         PREFIX_MAP  => { $sqlf_ns => 'sqlf' },
  46         DATA_MODE   => 1,
  47         DATA_INDENT => 2,
  48     );
  49
  50     $xml->xmlDecl('UTF-8');
  51     $xml->comment(header_comment('', ''));
  52     $xml->startTag([ $sqlf_ns => 'schema' ]);
  53
  54     for my $table ( $schema->get_tables ) {
  55         my $table_name = $table->name or next;
  56         $xml->startTag   ( [ $sqlf_ns => 'table' ] );
  57         $xml->dataElement( [ $sqlf_ns => 'name'  ], $table_name );
  58         $xml->dataElement( [ $sqlf_ns => 'order' ], $table->order );
  59
  60         #
  61         # Fields
  62         #
  63         $xml->startTag( [ $sqlf_ns => 'fields' ] );
  64         for my $field ( $table->get_fields ) {
  65             $xml->startTag( [ $sqlf_ns => 'field' ] );
  66
  67             for my $method (
  68                 qw[
  69                     name data_type default_value is_auto_increment
  70                     is_primary_key is_nullable is_foreign_key order size
  71                 ]
  72             ) {
  73                 my $val = $field->$method || '';
  74                 $xml->dataElement( [ $sqlf_ns => $method ], $val )
  75                     if ( defined $val ||
  76                         ( !defined $val && $args->{'emit_empty_tags'} ) );
  77             }
  78
  79             $xml->endTag( [ $sqlf_ns => 'field' ] );
  80         }
  81
  82         $xml->endTag( [ $sqlf_ns => 'fields' ] );
  83
  84         #
  85         # Indices
  86         #
  87         $xml->startTag( [ $sqlf_ns => 'indices' ] );
  88         for my $index ( $table->get_indices ) {
  89             $xml->startTag( [ $sqlf_ns => 'index' ] );
  90
  91             for my $method ( qw[ fields name options type ] ) {
  92                 my $val = $index->$method || '';
  93                    $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
  94                 $xml->dataElement( [ $sqlf_ns => $method ], $val )
  95                     if ( defined $val ||
  96                         ( !defined $val && $args->{'emit_empty_tags'} ) );
  97             }
  98
  99             $xml->endTag( [ $sqlf_ns => 'index' ] );
 100         }
 101         $xml->endTag( [ $sqlf_ns => 'indices' ] );
 102
 103         #
 104         # Constraints
 105         #
 106         $xml->startTag( [ $sqlf_ns => 'constraints' ] );
 107         for my $index ( $table->get_constraints ) {
 108             $xml->startTag( [ $sqlf_ns => 'constraint' ] );
 109
 110             for my $method (
 111                 qw[
 112                     deferrable expression fields match_type name
 113                     options on_delete on_update reference_fields
 114                     reference_table type
 115                 ]
 116             ) {
 117                 my $val = $index->$method || '';
 118                    $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
 119                 $xml->dataElement( [ $sqlf_ns => $method ], $val )
 120                     if ( defined $val ||
 121                         ( !defined $val && $args->{'emit_empty_tags'} ) );
 122             }
 123
 124             $xml->endTag( [ $sqlf_ns => 'constraint' ] );
 125         }
 126         $xml->endTag( [ $sqlf_ns => 'constraints' ] );
 127
 128         $xml->endTag( [ $sqlf_ns => 'table' ] );
 129     }
 130
 131     $xml->endTag([ $sqlf_ns => 'schema' ]);
 132     $xml->end;
 133
 134     return $io;
 135 }
 136
 137 1;
 138
 139 # -------------------------------------------------------------------
 140 # The eyes of fire, the nostrils of air,
 141 # The mouth of water, the beard of earth.
 142 # William Blake
 143 # -------------------------------------------------------------------
 144
 145 =head1 NAME
 146
 147 SQL::Translator::Producer::XML - XML output
 148
 149 =head1 SYNOPSIS
 150
 151   use SQL::Translator::Producer::XML;
 152
 153 =head1 DESCRIPTION
 154
 155 Meant to create some sort of usable XML output.
 156
 157 =head1 ARGS
 158
 159 Takes the following optional C<producer_args>:
 160
 161 =over 4
 162
 163 =item emit_empty_tags
 164
 165 If this is set to a true value, then tags corresponding to value-less
 166 elements will be emitted.  For example, take this schema:
 167
 168   CREATE TABLE random (
 169     id int auto_increment PRIMARY KEY,
 170     foo varchar(255) not null default '',
 171     updated timestamp
 172   );
 173
 174 With C<emit_empty_tags> = 1, this will be dumped with XML similar to:
 175
 176   <table>
 177     <name>random</name>
 178     <order>1</order>
 179     <fields>
 180       <field>
 181         <is_auto_inc>1</is_auto_inc>
 182         <list></list>
 183         <is_primary_key>1</is_primary_key>
 184         <data_type>int</data_type>
 185         <name>id</name>
 186         <constraints></constraints>
 187         <null>1</null>
 188         <order>1</order>
 189         <size></size>
 190         <type>field</type>
 191       </field>
 192
 193 With C<emit_empty_tags> = 0, you'd get:
 194
 195   <table>
 196     <name>random</name>
 197     <order>1</order>
 198     <fields>
 199       <field>
 200         <is_auto_inc>1</is_auto_inc>
 201         <is_primary_key>1</is_primary_key>
 202         <data_type>int</data_type>
 203         <name>id</name>
 204         <null>1</null>
 205         <order>1</order>
 206         <type>field</type>
 207       </field>
 208
 209 This can lead to dramatic size savings.
 210
 211 =back
 212
 213 =pod
 214
 215 =head1 AUTHOR
 216
 217 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 218
 219 =head1 SEE ALSO
 220
 221 XML::Dumper;
 222
 223 =cut