lib/SQL/Translator/Producer/XML.pm

   1 package SQL::Translator::Producer::XML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: XML.pm,v 1.8 2003-05-06 12:47:27 dlc 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.8 $ =~ /(\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 $prargs = $translator->producer_args;
  39     my $prargs = { };
  40     my $io = IO::Scalar->new;
  41
  42     my $xml = XML::Writer->new(OUTPUT      => $io,
  43                                NAMESPACES  => 1,
  44                                PREFIX_MAP  => { $sqlf_ns => 'sqlf' },
  45                                DATA_MODE   => 1,
  46                                DATA_INDENT => 2);
  47
  48
  49     $xml->xmlDecl("UTF-8");
  50     $xml->comment(header_comment('', ''));
  51     $xml->startTag([ $sqlf_ns => "schema" ]);
  52
  53     for my $table (
  54         map  { $_->[1] }
  55         sort { $a->[0] <=> $b->[0] }
  56         map  { [ $_->{'order'}, $_ ] }
  57         values %$data
  58     ) {
  59         $xml->startTag([ $sqlf_ns => "table" ]);
  60
  61         $xml->dataElement([ $sqlf_ns => "name" ], $table->{'table_name'});
  62         $xml->dataElement([ $sqlf_ns => "order" ], $table->{'order'});
  63
  64         #
  65         # Fields
  66         #
  67         $xml->startTag([ $sqlf_ns => "fields" ]);
  68         for my $field (
  69             map  { $_->[1] }
  70             sort { $a->[0] <=> $b->[0] }
  71             map  { [ $_->{'order'}, $_ ] }
  72             values %{ $table->{'fields'} }
  73         ) {
  74             $xml->startTag([ $sqlf_ns => "field" ]);
  75
  76             for my $key ( keys %$field ) {
  77                 my $val = defined $field->{ $key } ? $field->{ $key } : '';
  78                    $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
  79                 $xml->dataElement([ $sqlf_ns => $key ], $val)
  80                     if ($val || (!$val && $prargs->{'emit_empty_tags'}));
  81             }
  82
  83             $xml->endTag([ $sqlf_ns => "field" ]);
  84         }
  85         $xml->endTag([ $sqlf_ns => "fields" ]);
  86
  87         #
  88         # Indices
  89         #
  90         $xml->startTag([ $sqlf_ns => "indices" ]);
  91         for my $index (@{$table->{'indices'}}) {
  92             $xml->startTag([ $sqlf_ns => "index" ]);
  93
  94             for my $key (keys %$index) {
  95                 my $val = defined $index->{ $key } ? $index->{ $key } : '';
  96                    $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
  97                 $xml->dataElement([ $sqlf_ns => $key ], $val);
  98             }
  99
 100             $xml->endTag([ $sqlf_ns => "index" ]);
 101         }
 102         $xml->endTag([ $sqlf_ns => "indices" ]);
 103
 104         $xml->endTag([ $sqlf_ns => "table" ]);
 105     }
 106
 107     $xml->endTag([ $sqlf_ns => "schema" ]);
 108     $xml->end;
 109
 110     return $io;
 111 }
 112
 113 1;
 114 __END__
 115
 116 # -------------------------------------------------------------------
 117 # The eyes of fire, the nostrils of air,
 118 # The mouth of water, the beard of earth.
 119 # William Blake
 120 # -------------------------------------------------------------------
 121
 122 =head1 NAME
 123
 124 SQL::Translator::Producer::XML - XML output
 125
 126 =head1 SYNOPSIS
 127
 128   use SQL::Translator::Producer::XML;
 129
 130 =head1 DESCRIPTION
 131
 132 Meant to create some sort of usable XML output.
 133
 134 =head1 ARGS
 135
 136 Takes the following optional C<producer_args>:
 137
 138 =over 4
 139
 140 =item emit_empty_tags
 141
 142 If this is set to a true value, then tags corresponding to value-less
 143 elements will be emitted.  For example, take this schema:
 144
 145   CREATE TABLE random (
 146     id int auto_increment PRIMARY KEY,
 147     foo varchar(255) not null default '',
 148     updated timestamp
 149   );
 150
 151 With C<emit_empty_tags> = 1, this will be dumped with XML similar to:
 152
 153   <table>
 154     <name>random</name>
 155     <order>1</order>
 156     <fields>
 157       <field>
 158         <is_auto_inc>1</is_auto_inc>
 159         <list></list>
 160         <is_primary_key>1</is_primary_key>
 161         <data_type>int</data_type>
 162         <name>id</name>
 163         <constraints></constraints>
 164         <null>1</null>
 165         <order>1</order>
 166         <size></size>
 167         <type>field</type>
 168       </field>
 169
 170 With C<emit_empty_tags> = 0, you'd get:
 171
 172   <table>
 173     <name>random</name>
 174     <order>1</order>
 175     <fields>
 176       <field>
 177         <is_auto_inc>1</is_auto_inc>
 178         <is_primary_key>1</is_primary_key>
 179         <data_type>int</data_type>
 180         <name>id</name>
 181         <null>1</null>
 182         <order>1</order>
 183         <type>field</type>
 184       </field>
 185
 186 This can lead to dramatic size savings.
 187
 188 =back
 189
 190 =pod
 191
 192 =head1 AUTHOR
 193
 194 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 195
 196 =head1 SEE ALSO
 197
 198 XML::Dumper;
 199
 200 =cut