lib/SQL/Translator/Producer/XML.pm

   1 package SQL::Translator::Producer::XML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: XML.pm,v 1.7 2003-05-03 15:21:12 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 $XML ];
  27 $VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\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   = shift or return;
 110     my $indent = shift || 0;
 111     $XML .= ('  ' x $indent) . "$text\n";
 112 }
 113
 114 1;
 115 __END__
 116
 117 # -------------------------------------------------------------------
 118 # The eyes of fire, the nostrils of air,
 119 # The mouth of water, the beard of earth.
 120 # William Blake
 121 # -------------------------------------------------------------------
 122
 123 =head1 NAME
 124
 125 SQL::Translator::Producer::XML - XML output
 126
 127 =head1 SYNOPSIS
 128
 129   use SQL::Translator::Producer::XML;
 130
 131 =head1 DESCRIPTION
 132
 133 Meant to create some sort of usable XML output.
 134
 135 =head1 ARGS
 136
 137 Takes the following optional C<producer_args>:
 138
 139 =over 4
 140
 141 =item emit_empty_tags
 142
 143 If this is set to a true value, then tags corresponding to value-less
 144 elements will be emitted.  For example, take this schema:
 145
 146   CREATE TABLE random (
 147     id int auto_increment PRIMARY KEY,
 148     foo varchar(255) not null default '',
 149     updated timestamp
 150   );
 151
 152 With C<emit_empty_tags> = 1, this will be dumped with XML similar to:
 153
 154   <table>
 155     <name>random</name>
 156     <order>1</order>
 157     <fields>
 158       <field>
 159         <is_auto_inc>1</is_auto_inc>
 160         <list></list>
 161         <is_primary_key>1</is_primary_key>
 162         <data_type>int</data_type>
 163         <name>id</name>
 164         <constraints></constraints>
 165         <null>1</null>
 166         <order>1</order>
 167         <size></size>
 168         <type>field</type>
 169       </field>
 170
 171 With C<emit_empty_tags> = 0, you'd get:
 172
 173   <table>
 174     <name>random</name>
 175     <order>1</order>
 176     <fields>
 177       <field>
 178         <is_auto_inc>1</is_auto_inc>
 179         <is_primary_key>1</is_primary_key>
 180         <data_type>int</data_type>
 181         <name>id</name>
 182         <null>1</null>
 183         <order>1</order>
 184         <type>field</type>
 185       </field>
 186
 187 This can lead to dramatic size savings.
 188
 189 =back
 190
 191 =pod
 192
 193 =head1 AUTHOR
 194
 195 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 196
 197 =head1 SEE ALSO
 198
 199 XML::Dumper;
 200
 201 =cut