Commit | Line | Data |
45df156a |
1 | #!/usr/bin/perl |
2 | |
3 | # ------------------------------------------------------------------- |
4 | # $Id: sqlt.cgi,v 1.1 2003-08-26 16:25:34 kycl4rk Exp $ |
5 | # ------------------------------------------------------------------- |
6 | # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org> |
7 | # |
8 | # This program is free software; you can redistribute it and/or |
9 | # modify it under the terms of the GNU General Public License as |
10 | # published by the Free Software Foundation; version 2. |
11 | # |
12 | # This program is distributed in the hope that it will be useful, but |
13 | # WITHOUT ANY WARRANTY; without even the implied warranty of |
14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 | # General Public License for more details. |
16 | # |
17 | # You should have received a copy of the GNU General Public License |
18 | # along with this program; if not, write to the Free Software |
19 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
20 | # 02111-1307 USA |
21 | # ------------------------------------------------------------------- |
22 | |
23 | =head1 NAME |
24 | |
25 | sqlt.cgi |
26 | |
27 | =head1 DESCRIPTION |
28 | |
29 | A CGI front-end for SQL::Translator. |
30 | |
31 | =cut |
32 | |
33 | use strict; |
34 | use CGI; |
35 | use SQL::Translator; |
36 | |
37 | use vars '$VERSION'; |
38 | $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; |
39 | |
40 | my $q = CGI->new; |
41 | |
42 | eval { |
43 | if ( $q->param ) { |
44 | my $t = SQL::Translator->new( |
45 | from => $q->param('parser'), |
46 | producer_args => { |
47 | image_type => $q->param('output_type') || 'png', |
48 | title => $q->param('title') || 'Schema', |
49 | natural_join => $q->param('natural_join') eq 'no' ? 0 : 1, |
50 | join_pk_only => $q->param('natural_join') eq 'pk_only' ? 1 : 0, |
51 | add_color => $q->param('add_color'), |
52 | skip_fields => $q->param('skip_fields'), |
53 | show_fk_only => $q->param('show_fk_only'), |
54 | font_size => $q->param('font_size'), |
55 | no_columns => $q->param('no_columns'), |
56 | node_shape => $q->param('node_shape'), |
57 | layout => $q->param('layout') || '', |
58 | height => $q->param('height') || 0, |
59 | width => $q->param('width') || 0, |
60 | show_fields => $q->param('show_fields') || 0, |
61 | }, |
62 | ) or die SQL::Translator->error; |
63 | |
64 | my $data; |
65 | if ( $q->param('schema') ) { |
66 | $data = $q->param('schema'); |
67 | } |
68 | elsif ( my $fh = $q->upload('schema_file') ) { |
69 | local $/; |
70 | $data = <$fh>; |
71 | } |
72 | die "No schema provided!\n" unless $data; |
73 | |
74 | my $producer = $q->param('producer'); |
75 | my $image_type = $q->param('output_type') || 'png'; |
76 | my $header_type = |
77 | $producer =~ m/(GraphViz|Diagram)/ |
78 | ? "image/$image_type" |
79 | : 'text/plain'; |
80 | |
81 | $t->data( $data ); |
82 | $t->producer( $producer ); |
83 | my $output = $t->translate or die $t->error; |
84 | |
85 | print $q->header( -type => $header_type ), $output; |
86 | } |
87 | else { |
88 | show_form( $q ); |
89 | } |
90 | }; |
91 | |
92 | if ( my $error = $@ ) { |
93 | print $q->header, $q->start_html('Error'), |
94 | $q->h1('Error'), $error, $q->end_html; |
95 | } |
96 | |
97 | # ------------------------------------------------------------------- |
98 | sub show_form { |
99 | my $q = shift; |
100 | my $title = 'SQL::Translator'; |
101 | |
102 | print $q->header, |
103 | $q->start_html( -title => $title ), |
104 | $q->h1( qq[<a href="http://sqlfairy.sourceforge.net">$title</a>] ), |
105 | $q->start_form(-enctype => 'multipart/form-data'), |
106 | $q->table( { -border => 1 }, |
107 | $q->Tr( |
108 | $q->td( [ |
109 | 'Paste your schema here:', |
110 | $q->textarea( |
111 | -name => 'schema', |
112 | -rows => 10, |
113 | -columns => 60, |
114 | ), |
115 | ] ), |
116 | ), |
117 | $q->Tr( |
118 | $q->td( [ |
119 | 'Or upload your schema file:', |
120 | $q->filefield( -name => 'schema_file'), |
121 | ] ), |
122 | ), |
123 | $q->Tr( |
124 | $q->td( [ |
125 | 'Parser:', |
126 | $q->radio_group( |
127 | -name => 'parser', |
128 | -values => [ 'MySQL', 'PostgreSQL', 'Oracle' ], |
129 | -default => 'MySQL', |
130 | -rows => 3, |
131 | ), |
132 | ] ), |
133 | ), |
134 | $q->Tr( |
135 | $q->td( [ |
136 | 'Producer:', |
137 | $q->radio_group( |
138 | -name => 'producer', |
139 | -values => [ qw[ ClassDBI Diagram GraphViz HTML |
140 | MySQL Oracle POD PostgreSQL SQLite Sybase XML |
141 | ] ], |
142 | -default => 'GraphViz', |
143 | -rows => 3, |
144 | ), |
145 | ] ), |
146 | ), |
147 | $q->Tr( |
148 | $q->td( [ |
149 | 'Title:', |
150 | $q->textfield('title'), |
151 | ] ), |
152 | ), |
153 | $q->Tr( |
154 | $q->td( [ |
155 | 'Output Type:', |
156 | $q->radio_group( |
157 | -name => 'output_type', |
158 | -values => [ 'png', 'jpeg' ], |
159 | -default => 'png', |
160 | -rows => 2, |
161 | ), |
162 | ] ), |
163 | ), |
164 | $q->Tr( |
165 | $q->td( [ |
166 | 'Perform Natural Joins:', |
167 | $q->radio_group( |
168 | -name => 'natural_join', |
169 | -values => [ 'no', 'yes', 'pk_only' ], |
170 | -labels => { |
171 | no => 'No', |
172 | yes => 'Yes, on all like-named fields', |
173 | pk_only => 'Yes, but only from primary keys' |
174 | }, |
175 | -default => 'no', |
176 | -rows => 3, |
177 | ), |
178 | ] ), |
179 | ), |
180 | $q->Tr( |
181 | $q->td( [ |
182 | 'Skip These Fields in Natural Joins:', |
183 | $q->textarea( |
184 | -name => 'skip_fields', |
185 | -rows => 3, |
186 | -columns => 60, |
187 | ), |
188 | ] ), |
189 | ), |
190 | $q->Tr( |
191 | $q->td( [ |
192 | 'Color:', |
193 | $q->radio_group( |
194 | -name => 'add_color', |
195 | -values => [ 1, 0 ], |
196 | -labels => { |
197 | 1 => 'Yes', |
198 | 0 => 'No' |
199 | }, |
200 | -default => 1, |
201 | -rows => 2, |
202 | ), |
203 | ] ), |
204 | ), |
205 | $q->Tr( |
206 | $q->td( [ |
207 | 'Show Only Foreign Keys *:', |
208 | $q->radio_group( |
209 | -name => 'show_fk_only', |
210 | -values => [ 1, 0 ], |
211 | -default => 0, |
212 | -labels => { |
213 | 1 => 'Yes', |
214 | 0 => 'No', |
215 | }, |
216 | -rows => 2, |
217 | ), |
218 | ] ), |
219 | ), |
220 | $q->Tr( |
221 | $q->td( [ |
222 | 'Font Size *:', |
223 | $q->radio_group( |
224 | -name => 'font_size', |
225 | -values => [ qw( small medium large ) ], |
226 | -default => 'medium', |
227 | -rows => 3, |
228 | ), |
229 | ] ), |
230 | ), |
231 | $q->Tr( |
232 | $q->td( [ |
233 | 'Number of Columns *:', |
234 | $q->textfield('no_columns'), |
235 | ] ), |
236 | ), |
237 | $q->Tr( |
238 | $q->td( [ |
239 | 'Layout **:', |
240 | $q->radio_group( |
241 | -name => 'layout', |
242 | -values => [ qw( dot neato twopi ) ], |
243 | -default => 'dot', |
244 | -rows => 3, |
245 | ), |
246 | ] ), |
247 | ), |
248 | $q->Tr( |
249 | $q->td( [ |
250 | 'Node Shape **:', |
251 | $q->radio_group( |
252 | -name => 'node_shape', |
253 | -values => [ qw( record plaintext ellipse |
254 | circle egg triangle box diamond trapezium |
255 | parallelogram house hexagon octagon |
256 | ) ], |
257 | -default => 'record', |
258 | -rows => 13, |
259 | ), |
260 | ] ), |
261 | ), |
262 | $q->Tr( |
263 | $q->td( [ |
264 | 'Show Field Names **:', |
265 | $q->radio_group( |
266 | -name => 'show_fields', |
267 | -values => [ 1, 0 ], |
268 | -default => 1, |
269 | -labels => { |
270 | 1 => 'Yes', |
271 | 0 => 'No', |
272 | }, |
273 | -rows => 2, |
274 | ), |
275 | ] ), |
276 | ), |
277 | $q->Tr( |
278 | $q->td( [ |
279 | 'Height **:', |
280 | $q->textfield( -name => 'height', -default => 11 ), |
281 | ] ), |
282 | ), |
283 | $q->Tr( |
284 | $q->td( [ |
285 | 'Width **:', |
286 | $q->textfield( -name => 'width', -default => 8.5 ), |
287 | ] ), |
288 | ), |
289 | $q->Tr( |
290 | $q->td( |
291 | { -colspan => 2, -align => 'center' }, |
292 | $q->submit( |
293 | -name => 'submit', |
294 | -value => 'Submit', |
295 | ), |
296 | $q->br, |
297 | q[ |
298 | <small> |
299 | * -- Applies to diagram only<br> |
300 | ** -- Applies to graph only<br> |
301 | </small> |
302 | ], |
303 | ), |
304 | ), |
305 | ), |
306 | $q->end_form, |
307 | $q->end_html; |
308 | } |
309 | |
310 | # ------------------------------------------------------------------- |
311 | |
312 | =pod |
313 | |
314 | =head1 AUTHOR |
315 | |
316 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt> |
317 | |
318 | =head1 SEE ALSO |
319 | |
320 | perl, SQL::Translator. |
321 | |
322 | =cut |