1 package SQL::Translator::Producer::SqlfXML;
3 # -------------------------------------------------------------------
4 # $Id: SqlfXML.pm,v 1.1 2003-08-06 17:14:09 grommit Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7 # darren chamberlain <darren@cpan.org>,
8 # Chris Mungall <cjm@fruitfly.org>
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.
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.
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
23 # -------------------------------------------------------------------
26 use vars qw[ $VERSION ];
27 $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
30 use SQL::Translator::Utils qw(header_comment);
33 my $namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
36 # -------------------------------------------------------------------
38 my $translator = shift;
39 my $schema = $translator->schema;
40 my $args = $translator->producer_args;
42 my $io = IO::Scalar->new;
43 my $xml = XML::Writer->new(
46 PREFIX_MAP => { $namespace => $name },
51 $xml->xmlDecl('UTF-8');
52 $xml->comment(header_comment('', ''));
53 $xml->startTag([ $namespace => 'schema' ]);
55 for my $table ( $schema->get_tables ) {
56 my $table_name = $table->name or next;
57 $xml->startTag ( [ $namespace => 'table' ] );
58 $xml->dataElement( [ $namespace => 'name' ], $table_name );
59 $xml->dataElement( [ $namespace => 'order' ], $table->order );
64 $xml->startTag( [ $namespace => 'fields' ] );
65 for my $field ( $table->get_fields ) {
66 $xml->startTag( [ $namespace => 'field' ] );
70 name data_type default_value is_auto_increment
71 is_primary_key is_nullable is_foreign_key order size
74 my $val = $field->$method || '';
75 $xml->dataElement( [ $namespace => $method ], $val )
77 ( !defined $val && $args->{'emit_empty_tags'} ) );
80 $xml->endTag( [ $namespace => 'field' ] );
83 $xml->endTag( [ $namespace => 'fields' ] );
88 $xml->startTag( [ $namespace => 'indices' ] );
89 for my $index ( $table->get_indices ) {
90 $xml->startTag( [ $namespace => 'index' ] );
92 for my $method ( qw[ fields name options type ] ) {
93 my $val = $index->$method || '';
94 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
95 $xml->dataElement( [ $namespace => $method ], $val )
97 ( !defined $val && $args->{'emit_empty_tags'} ) );
100 $xml->endTag( [ $namespace => 'index' ] );
102 $xml->endTag( [ $namespace => 'indices' ] );
107 $xml->startTag( [ $namespace => 'constraints' ] );
108 for my $index ( $table->get_constraints ) {
109 $xml->startTag( [ $namespace => 'constraint' ] );
113 deferrable expression fields match_type name
114 options on_delete on_update reference_fields
118 my $val = $index->$method || '';
119 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
120 $xml->dataElement( [ $namespace => $method ], $val )
122 ( !defined $val && $args->{'emit_empty_tags'} ) );
125 $xml->endTag( [ $namespace => 'constraint' ] );
127 $xml->endTag( [ $namespace => 'constraints' ] );
129 $xml->endTag( [ $namespace => 'table' ] );
132 $xml->endTag([ $namespace => 'schema' ]);
140 # -------------------------------------------------------------------
141 # The eyes of fire, the nostrils of air,
142 # The mouth of water, the beard of earth.
144 # -------------------------------------------------------------------
148 SQL::Translator::Producer::SqlfXML - XML output
154 my $translator = SQL::Translator->new(
158 print = $obj->translate(
161 filename => "fooschema.sql",
166 Creates XML output of a schema.
170 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>, darren chamberlain E<lt>darren@cpan.orgE<gt>
174 perl(1), SQL::Translator, SQL::Translator::Parser::SqlfXML,
175 SQL::Translator::Schema, XML::Writer.