Commit | Line | Data |
c957e92d |
1 | package SQL::Translator::Producer::SqlfXML; |
16dc9970 |
2 | |
d529894e |
3 | # ------------------------------------------------------------------- |
a8e0cc1a |
4 | # $Id: SqlfXML.pm,v 1.4 2003-08-14 12:03:00 grommit Exp $ |
d529894e |
5 | # ------------------------------------------------------------------- |
abfa405a |
6 | # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>, |
7 | # darren chamberlain <darren@cpan.org>, |
8 | # Chris Mungall <cjm@fruitfly.org> |
16dc9970 |
9 | # |
d529894e |
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 | |
16dc9970 |
25 | use strict; |
d0c12b9f |
26 | use warnings; |
fb6b0318 |
27 | use vars qw[ $VERSION ]; |
a8e0cc1a |
28 | $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/; |
d0c12b9f |
29 | |
30 | use Exporter; |
31 | use base qw(Exporter); |
32 | our @EXPORT_OK = qw(produce); |
5ee19df8 |
33 | |
fb6b0318 |
34 | use IO::Scalar; |
5ee19df8 |
35 | use SQL::Translator::Utils qw(header_comment); |
fb6b0318 |
36 | use XML::Writer; |
37 | |
03afabda |
38 | my $namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml'; |
39 | my $name = 'sqlt'; |
16dc9970 |
40 | |
d0c12b9f |
41 | { |
a8e0cc1a |
42 | our ($translator,$PArgs,$schema); |
d0c12b9f |
43 | |
44 | sub debug { $translator->debug(@_,"\n"); } # Shortcut. |
45 | |
4b603a3f |
46 | sub produce { |
d0c12b9f |
47 | $translator = shift; |
a8e0cc1a |
48 | $PArgs = $translator->producer_args; |
49 | $schema = $translator->schema; |
c6a7dcb1 |
50 | |
d0c12b9f |
51 | my $io = IO::Scalar->new; |
03afabda |
52 | my $xml = XML::Writer->new( |
c6a7dcb1 |
53 | OUTPUT => $io, |
54 | NAMESPACES => 1, |
03afabda |
55 | PREFIX_MAP => { $namespace => $name }, |
c6a7dcb1 |
56 | DATA_MODE => 1, |
57 | DATA_INDENT => 2, |
58 | ); |
59 | |
60 | $xml->xmlDecl('UTF-8'); |
fb6b0318 |
61 | $xml->comment(header_comment('', '')); |
03afabda |
62 | $xml->startTag([ $namespace => 'schema' ]); |
61745327 |
63 | |
d0c12b9f |
64 | # |
65 | # Table |
66 | # |
c6a7dcb1 |
67 | for my $table ( $schema->get_tables ) { |
d0c12b9f |
68 | debug "Table:",$table->name; |
a8e0cc1a |
69 | xml_obj($xml, $table, |
70 | tag => "table", methods => [qw/name order/], end_tag => 0 ); |
71 | |
61745327 |
72 | # |
73 | # Fields |
74 | # |
03afabda |
75 | $xml->startTag( [ $namespace => 'fields' ] ); |
c6a7dcb1 |
76 | for my $field ( $table->get_fields ) { |
d0c12b9f |
77 | debug " Field:",$field->name; |
a8e0cc1a |
78 | xml_obj($xml, $field, |
79 | tag =>"field", |
80 | end_tag => 1, |
81 | methods =>[qw/name data_type default_value is_auto_increment |
d0c12b9f |
82 | is_primary_key is_nullable is_foreign_key order size |
a8e0cc1a |
83 | /], |
84 | ); |
61745327 |
85 | } |
03afabda |
86 | $xml->endTag( [ $namespace => 'fields' ] ); |
61745327 |
87 | |
88 | # |
89 | # Indices |
90 | # |
03afabda |
91 | $xml->startTag( [ $namespace => 'indices' ] ); |
c6a7dcb1 |
92 | for my $index ( $table->get_indices ) { |
d0c12b9f |
93 | debug "Index:",$index->name; |
a8e0cc1a |
94 | xml_obj($xml, $index, |
95 | tag => "index", |
96 | end_tag => 1, |
97 | methods =>[qw/fields name options type/], |
98 | ); |
c6a7dcb1 |
99 | } |
03afabda |
100 | $xml->endTag( [ $namespace => 'indices' ] ); |
c6a7dcb1 |
101 | |
102 | # |
103 | # Constraints |
104 | # |
03afabda |
105 | $xml->startTag( [ $namespace => 'constraints' ] ); |
c6a7dcb1 |
106 | for my $index ( $table->get_constraints ) { |
d0c12b9f |
107 | debug "Constraint:",$index->name; |
a8e0cc1a |
108 | xml_obj($xml, $index, |
109 | tag => "constraint", |
110 | end_tag => 1, |
111 | methods =>[qw/ |
c6a7dcb1 |
112 | deferrable expression fields match_type name |
113 | options on_delete on_update reference_fields |
a8e0cc1a |
114 | reference_table type/], |
115 | ); |
61745327 |
116 | } |
03afabda |
117 | $xml->endTag( [ $namespace => 'constraints' ] ); |
61745327 |
118 | |
03afabda |
119 | $xml->endTag( [ $namespace => 'table' ] ); |
61745327 |
120 | } |
121 | |
03afabda |
122 | $xml->endTag([ $namespace => 'schema' ]); |
fb6b0318 |
123 | $xml->end; |
61745327 |
124 | |
fb6b0318 |
125 | return $io; |
16dc9970 |
126 | } |
127 | |
a8e0cc1a |
128 | sub xml_obj { |
129 | my ($xml, $obj, %args) = @_; |
130 | my $tag = $args{tag}; |
131 | my @meths = @{$args{methods}}; |
132 | my $attrib_values = $PArgs->{attrib_values}; |
133 | my $empty_tag = 0; |
134 | my $end_tag = $args{end_tag}; |
135 | if ( $attrib_values and $end_tag ) { |
136 | $empty_tag = 1; |
137 | $end_tag = 0; |
138 | } |
139 | |
140 | if ( $attrib_values ) { |
141 | my %attr = map { |
142 | my $val = $obj->$_; |
143 | ($_ => ref($val) eq 'ARRAY' ? join(", ",@$val) : $val); |
144 | } @meths; |
145 | foreach (keys %attr) { delete $attr{$_} unless defined $attr{$_}; } |
146 | $empty_tag ? $xml->emptyTag( [ $namespace => $tag ], %attr ) |
147 | : $xml->startTag( [ $namespace => $tag ], %attr ); |
148 | } |
149 | else { |
150 | $xml->startTag( [ $namespace => $tag ] ); |
151 | xml_objAttr($xml,$obj, @meths); |
152 | } |
153 | $xml->endTag( [ $namespace => $tag ] ) if $end_tag; |
154 | |
155 | } |
156 | |
157 | # Takes an xml writer, a Schema::* object and a list of methods and adds the |
d0c12b9f |
158 | # XML for those methods. |
159 | sub xml_objAttr { |
160 | my ($xml, $obj, @methods) = @_; |
a8e0cc1a |
161 | my $emit_empty = $PArgs->{emit_empty_tags}; |
162 | for my $method (@methods) { |
d0c12b9f |
163 | my $val = $obj->$method; |
164 | debug " ".ref($obj)."->$method=", |
165 | (defined $val ? "'$val'" : "<UNDEF>"); |
a8e0cc1a |
166 | next unless $emit_empty || defined $val; |
d0c12b9f |
167 | $val = "" if not defined $val; |
168 | $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val; |
169 | debug " Adding Attr:".$method."='",$val,"'"; |
170 | $xml->dataElement( [ $namespace => $method ], $val ); |
171 | } |
172 | } |
a8e0cc1a |
173 | |
d0c12b9f |
174 | } # End of our scoped bit |
175 | |
16dc9970 |
176 | 1; |
d529894e |
177 | |
178 | # ------------------------------------------------------------------- |
16dc9970 |
179 | # The eyes of fire, the nostrils of air, |
180 | # The mouth of water, the beard of earth. |
181 | # William Blake |
d529894e |
182 | # ------------------------------------------------------------------- |
16dc9970 |
183 | |
5ee19df8 |
184 | =head1 NAME |
185 | |
c957e92d |
186 | SQL::Translator::Producer::SqlfXML - XML output |
5ee19df8 |
187 | |
188 | =head1 SYNOPSIS |
189 | |
c957e92d |
190 | use SQL::Translator; |
191 | |
192 | my $translator = SQL::Translator->new( |
193 | show_warnings => 1, |
194 | add_drop_table => 1, |
195 | ); |
196 | print = $obj->translate( |
197 | from => "MySQL", |
198 | to => "SqlfXML", |
199 | filename => "fooschema.sql", |
200 | ); |
5ee19df8 |
201 | |
a8e0cc1a |
202 | =head1 ARGS |
203 | |
204 | Takes the following extra producer args. |
205 | |
206 | =item emit_empty_tags |
207 | |
208 | Default is false, set to true to emit <foo></foo> style tags for undef values |
209 | in the schema. |
210 | |
211 | =item attrib_values |
212 | |
213 | Set true to use attributes for values of the schema objects instead of tags. |
214 | |
215 | <!-- attrib_values => 0 --> |
216 | <table> |
217 | <name>foo</name> |
218 | <order>1</order> |
219 | </table> |
220 | |
221 | <!-- attrib_values => 1 --> |
222 | <table name="foo" order="1"> |
223 | </table> |
224 | |
5ee19df8 |
225 | =head1 DESCRIPTION |
226 | |
03afabda |
227 | Creates XML output of a schema. |
16dc9970 |
228 | |
d0c12b9f |
229 | =head1 TODO |
230 | |
16dc9970 |
231 | =head1 AUTHOR |
232 | |
d0c12b9f |
233 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt>, |
234 | darren chamberlain E<lt>darren@cpan.orgE<gt>, |
235 | mark addison E<lt>mark.addison@itn.co.ukE<gt>, |
16dc9970 |
236 | |
237 | =head1 SEE ALSO |
238 | |
c957e92d |
239 | perl(1), SQL::Translator, SQL::Translator::Parser::SqlfXML, |
240 | SQL::Translator::Schema, XML::Writer. |