lib/SQL/Translator/Producer/XML.pm

   1 package SQL::Translator::Producer::XML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: XML.pm,v 1.6 2003-04-25 11:47:25 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 $XML ];
  27 $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
  28
  29 use SQL::Translator::Utils qw(header_comment);
  30
  31 # -------------------------------------------------------------------
  32 sub produce {
  33     my ( $translator, $data ) = @_;
  34     my $prargs = $translator->producer_args;
  35     my $indent = 0;
  36     aggregate('<?xml version="1.0"?>', $indent);
  37     aggregate('<schema>', $indent);
  38     aggregate('<!-- ' . header_comment('', '') . '-->');
  39
  40     $indent++;
  41     for my $table (
  42         map  { $_->[1] }
  43         sort { $a->[0] <=> $b->[0] }
  44         map  { [ $_->{'order'}, $_ ] }
  45         values %$data
  46     ) {
  47         aggregate( '<table>', $indent );
  48         $indent++;
  49
  50         aggregate( "<name>$table->{'table_name'}</name>", $indent );
  51         aggregate( "<order>$table->{'order'}</order>", $indent );
  52
  53         #
  54         # Fields
  55         #
  56         aggregate( '<fields>', $indent );
  57         for my $field (
  58             map  { $_->[1] }
  59             sort { $a->[0] <=> $b->[0] }
  60             map  { [ $_->{'order'}, $_ ] }
  61             values %{ $table->{'fields'} }
  62         ) {
  63             aggregate( '<field>', ++$indent );
  64             $indent++;
  65
  66             for my $key ( keys %$field ) {
  67                 my $val = defined $field->{ $key } ? $field->{ $key } : '';
  68                    $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
  69                 aggregate("<$key>$val</$key>", $indent)
  70                     if ($val || (!$val && $prargs->{'emit_empty_tags'}));
  71             }
  72
  73             $indent--;
  74             aggregate("</field>", $indent--);
  75         }
  76         aggregate( "</fields>", $indent );
  77
  78         #
  79         # Indices
  80         #
  81         aggregate( '<indices>', $indent );
  82         for my $index ( @{ $table->{'indices'} } ) {
  83             aggregate( '<index>', ++$indent );
  84             $indent++;
  85
  86             for my $key ( keys %$index ) {
  87                 my $val = defined $index->{ $key } ? $index->{ $key } : '';
  88                    $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
  89                 aggregate( "<$key>$val</$key>", $indent );
  90             }
  91
  92             $indent--;
  93             aggregate( "</index>", $indent-- );
  94         }
  95         aggregate( "</indices>", $indent );
  96
  97         $indent--;
  98         aggregate( "</table>", $indent );
  99     }
 100
 101     $indent--;
 102     aggregate( '</schema>', $indent );
 103
 104     return $XML;
 105 }
 106
 107 # -------------------------------------------------------------------
 108 sub aggregate {
 109     my ( $text, $indent ) = @_;
 110     $XML .= ('  ' x $indent) . "$text\n";
 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