Commit | Line | Data |
16dc9970 |
1 | package SQL::Translator; |
2 | |
3 | #----------------------------------------------------- |
1fd8c91f |
4 | # $Id: Translator.pm,v 1.2 2002-03-07 14:06:20 dlc Exp $ |
16dc9970 |
5 | #----------------------------------------------------- |
1fd8c91f |
6 | # Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>, |
7 | # darren chamberlain <darren@cpan.org> |
8 | # |
9 | # This program is free software; you can redistribute it and/or |
10 | # modify it under the terms of the GNU General Public License as |
11 | # published by the Free Software Foundation; version 2. |
12 | # |
13 | # This program is distributed in the hope that it will be useful, but |
14 | # WITHOUT ANY WARRANTY; without even the implied warranty of |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
16 | # General Public License for more details. |
17 | # |
18 | # You should have received a copy of the GNU General Public License |
19 | # along with this program; if not, write to the Free Software |
20 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
21 | # 02111-1307 USA |
22 | # ------------------------------------------------------------------- |
23 | |
24 | =head1 NAME |
25 | |
26 | SQL::Translator - convert schema from one database to another |
27 | |
28 | =head1 SYNOPSIS |
29 | |
30 | use SQL::Translator; |
31 | my $translator = SQL::Translator->new; |
32 | my $output = $translator->translate( |
33 | parser => 'mysql', |
34 | producer => 'oracle', |
35 | file => $file, |
36 | ) or die $translator->error; |
37 | print $output; |
38 | |
39 | =head1 DESCRIPTION |
40 | |
41 | This module attempts to simplify the task of converting one database |
42 | create syntax to another through the use of Parsers and Producers. |
43 | The idea is that any Parser can be used with any Producer in the |
44 | conversion process. So, if you wanted PostgreSQL-to-Oracle, you could |
45 | just write the PostgreSQL parser and use an existing Oracle producer. |
46 | |
47 | Currently, the existing parsers use Parse::RecDescent, and the |
48 | producers are just printing formatted output of the parsed data |
49 | structure. New parsers don't necessarily have to use |
50 | Parse::RecDescent, however, as long as the data structure conforms to |
51 | what the producers are expecting. With this separation of code, it is |
52 | hoped that developers will find it easy to add more database dialects |
53 | by using what's written, writing only what they need, and then |
54 | contributing their parsers or producers back to the project. |
55 | |
56 | =cut |
16dc9970 |
57 | |
58 | use strict; |
1fd8c91f |
59 | use vars qw($VERSION $DEFAULT_SUB $DEBUG); |
60 | $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; |
61 | $DEBUG = 1 unless defined $DEBUG; |
16dc9970 |
62 | |
1fd8c91f |
63 | $DEFAULT_SUB = sub { $_[0] } unless defined $DEFAULT_SUB; |
64 | *isa = \&UNIVERSAL::isa; |
16dc9970 |
65 | |
1fd8c91f |
66 | =head1 CONSTRUCTOR |
16dc9970 |
67 | |
1fd8c91f |
68 | The constructor is called B<new>, and accepts a hash of options. |
69 | Valid options are: |
16dc9970 |
70 | |
1fd8c91f |
71 | =over 4 |
72 | |
73 | =item parser (aka from) |
74 | |
75 | =item producer (aka to) |
76 | |
77 | =item filename |
78 | |
79 | =back |
80 | |
81 | All options are, well, optional; these attributes can be set via |
82 | instance methods. |
83 | |
84 | =cut |
85 | |
86 | # {{{ new |
16dc9970 |
87 | |
16dc9970 |
88 | sub new { |
16dc9970 |
89 | my $class = shift; |
1fd8c91f |
90 | my $args = isa($_[0], 'HASH') ? shift : { @_ }; |
91 | my $self = bless { } => $class; |
16dc9970 |
92 | |
1fd8c91f |
93 | # |
94 | # Set the parser and producer. If a 'parser' or 'from' parameter |
95 | # is passed in, use that as the parser; if a 'producer' or 'to' |
96 | # parameter is passed in, use that as the producer; both default |
97 | # to $DEFAULT_SUB. |
98 | # |
99 | $self->parser( $args->{'parser'} || $args->{'from'} || $DEFAULT_SUB); |
100 | $self->producer($args->{'producer'} || $args->{'to'} || $DEFAULT_SUB); |
101 | |
102 | # |
103 | # Clear the error |
104 | # |
105 | $self->error_out(""); |
106 | |
107 | return $self; |
16dc9970 |
108 | } |
1fd8c91f |
109 | # }}} |
16dc9970 |
110 | |
1fd8c91f |
111 | =head1 METHODS |
112 | |
113 | |
114 | =head2 B<producer> |
115 | |
116 | The B<producer> method is an accessor/mutator, used to retrieve or |
117 | define what subroutine is called to produce the output. A subroutine |
118 | defined as a producer subroutine will be invoked as a function (not a |
119 | method) and passed a data structure as its only argument. It is |
120 | expected that the function transform the data structure to the output |
121 | format, and return a string. |
122 | |
123 | When defining a producer, one of three things can be passed |
124 | in: A full module name (e.g., My::Groovy::Parser), a module name |
125 | relative to the SQL::Translator::Producer namespace (e.g., MySQL), or |
126 | a reference to an anonymous subroutine. If a full module name is |
127 | passed in, it is treated as a package, and a function called |
128 | "transform" will be invoked as $modulename::transform. |
129 | |
130 | my $tr = SQL::Translator->new; |
131 | |
132 | # This will invoke My::Groovy::Producer::transform($data) |
133 | $tr->producer("My::Groovy::Producer"); |
134 | |
135 | # This will invoke SQL::Translator::Producer::Sybase::transform($data) |
136 | $tr->producer("Sybase"); |
137 | |
138 | # This will inoke the referenced subroutine directly |
139 | $tr->producer(\&my_producer); |
140 | |
141 | =cut |
142 | # TODO Make mod_perl-like assumptions about the name being passed in: |
143 | # try to load the module; if that fails, pop off the last piece |
144 | # (everything after the last ::) and try to load that; if that loads, |
145 | # use the popped off piece as the function name, and not transform. |
146 | |
147 | # {{{ producer |
148 | sub producer { |
16dc9970 |
149 | my $self = shift; |
1fd8c91f |
150 | if (@_) { |
151 | my $producer = shift; |
152 | if ($producer =~ /::/) { |
153 | load($producer) or die "Can't load $producer: $@"; |
154 | $self->{'producer'} = \&{ "$producer\::'producer'" }; |
155 | $self->debug("Got 'producer': $producer\::'producer'"); |
156 | } elsif (isa($producer, 'CODE')) { |
157 | $self->{'producer'} = $producer; |
158 | $self->debug("Got 'producer': code ref"); |
159 | } else { |
160 | my $Pp = sprintf "SQL::Translator::Producer::$producer"; |
161 | load($Pp) or die "Can't load $Pp: $@"; |
162 | $self->{'producer'} = \&{ "$Pp\::translate" }; |
163 | $self->debug("Got producer: $Pp"); |
164 | } |
165 | # At this point, $self->{'producer'} contains a subroutine |
166 | # reference that is ready to run! |
16dc9970 |
167 | } |
1fd8c91f |
168 | return $self->{'producer'}; |
169 | }; |
170 | # }}} |
171 | |
172 | =head2 B<parser> |
173 | |
174 | The B<parser> method defines or retrieves a subroutine that will be |
175 | called to perform the parsing. The basic idea is the same as that of |
176 | B<producer> (see above), except the default subroutine name is |
177 | "parse", and will be invoked as $module_name::parse. Also, the parser |
178 | subroutine will be passed a string containing the entirety of the data |
179 | to be parsed. |
180 | |
181 | # Invokes SQL::Translator::Parser::MySQL::parse() |
182 | $tr->parser("MySQL"); |
183 | |
184 | # Invokes My::Groovy::Parser::parse() |
185 | $tr->parser("My::Groovy::Parser"); |
186 | |
187 | # Invoke an anonymous subroutine directly |
188 | $tr->parser(sub { |
189 | my $dumper = Data::Dumper->new([ $_[0] ], [ "SQL" ]); |
190 | $dumper->Purity(1)->Terse(1)->Deepcopy(1); |
191 | return $dumper->Dump; |
192 | }); |
193 | |
194 | =cut |
195 | |
196 | # {{{ parser |
197 | sub parser { |
198 | my $self = shift; |
199 | if (@_) { |
200 | my $parser = shift; |
201 | if ($parser =~ /::/) { |
202 | load($parser) or die "Can't load $parser: $@"; |
203 | $self->{'parser'} = \&{ "$parser\::parse" }; |
204 | $self->debug("Got parser: $parser\::parse"); |
205 | } elsif (isa($parser, 'CODE')) { |
206 | $self->{'parser'} = $parser; |
207 | $self->debug("Got parser: code ref"); |
208 | } else { |
209 | my $Pp = "SQL::Translator::Parser::$parser"; |
210 | load($Pp) or die "Can't load $Pp: $@"; |
211 | $self->{'parser'} = \&{ "$Pp\::parse" }; |
212 | $self->debug("Got parser: $Pp"); |
213 | } |
214 | # At this point, $self->{$pp} contains a subroutine |
215 | # reference that is ready to run! |
216 | } |
217 | return $self->{'parser'}; |
16dc9970 |
218 | } |
1fd8c91f |
219 | # }}} |
16dc9970 |
220 | |
1fd8c91f |
221 | =head2 B<translate> |
222 | |
223 | The B<translate> method calls the subroutines referenced by the |
224 | B<parser> and B<producer> data members (described above). It accepts |
225 | as arguments a number of things, in key => value format, including |
226 | (potentially) a parser and a producer (they are passed directly to the |
227 | B<parser> and B<producer> methods). |
228 | |
229 | Here is how the parameter list to B<translate> is parsed: |
230 | |
231 | =over |
232 | |
233 | =item * |
234 | |
235 | 1 argument means it's the data to be parsed; which could be a string |
236 | (filename), a reference to a GLOB (filehandle from which to read a |
237 | string), a refernce to a scalar (a string stored in memory), or a |
238 | reference to a hash (which means the same thing as below). |
239 | |
240 | # Parse the file /path/to/datafile |
241 | my $output = $tr->translate("/path/to/datafile"); |
242 | |
243 | # The same thing: |
244 | my $fh = IO::File->new("/path/to/datafile"); |
245 | my $output = $tr->translate($fh); |
246 | |
247 | # Again, the same thing: |
248 | my $fh = IO::File->new("/path/to/datafile"); |
249 | my $data = { local $/; <$fh> }; |
250 | my $output = $tr->translate(\$data); |
251 | |
252 | =item * |
253 | |
254 | > 1 argument means its a hash of things, and it might be setting a |
255 | parser, producer, or datasource (this key is named "filename" or |
256 | "file" if it's a file, or "data" for a GLOB or SCALAR reference). |
257 | |
258 | # As above, parse /path/to/datafile, but with different producers |
259 | for my $prod ("MySQL", "XML", "Sybase") { |
260 | print $tr->translate( |
261 | producer => $prod, |
262 | filename => "/path/to/datafile", |
263 | ); |
264 | } |
265 | |
266 | # The filename hash key could also be: |
267 | datasource => $fh, |
268 | |
269 | # or |
270 | datasource => \$data, |
271 | |
272 | You get the idea. |
273 | |
274 | =back |
275 | |
276 | =cut |
277 | |
278 | # {{{ translate |
16dc9970 |
279 | sub translate { |
1fd8c91f |
280 | my $self = shift; |
281 | my ($args, $parser, $producer); |
282 | |
283 | if (@_ == 1) { |
284 | if (isa($_[0], 'HASH')) { |
285 | # Passed a hashref |
286 | $args = $_[0]; |
287 | } |
288 | elsif (isa($_[0], 'GLOB')) { |
289 | # passed a filehandle; slurp it |
290 | local $/; |
291 | $args = { data => <$_[0]> }; |
292 | } |
293 | elsif (isa($_[0], 'SCALAR')) { |
294 | # passed a ref to a string; deref it |
295 | $args = { data => ${$_[0]} }; |
296 | } |
297 | else { |
298 | # Not a ref, it's a filename |
299 | $args = { filename => $_[0] }; |
300 | } |
16dc9970 |
301 | } |
302 | else { |
1fd8c91f |
303 | # Should we check if @_ % 2, or just eat the errors if they occur? |
304 | $args = { @_ }; |
16dc9970 |
305 | } |
306 | |
1fd8c91f |
307 | if ((defined $args->{'filename'} || |
308 | defined $args->{'file'} ) && not $args->{'data'}) { |
309 | local *FH; |
310 | local $/; |
311 | |
312 | open FH, $args->{'filename'} or die $!; |
313 | $args->{'data'} = <FH>; |
314 | close FH or die $!; |
16dc9970 |
315 | } |
1fd8c91f |
316 | |
317 | # |
318 | # Last chance to bail out; if there's nothing in the data |
319 | # key of %args, back out. |
320 | # |
321 | return unless defined $args->{'data'}; |
322 | |
323 | # |
324 | # Local reference to the parser subroutine |
325 | # |
326 | if ($parser = ($args->{'parser'} || $args->{'from'})) { |
327 | $self->parser($parser); |
328 | } else { |
329 | $parser = $self->parser; |
16dc9970 |
330 | } |
331 | |
332 | # |
1fd8c91f |
333 | # Local reference to the producer subroutine |
16dc9970 |
334 | # |
1fd8c91f |
335 | if ($producer = ($args->{'producer'} || $args->{'to'})) { |
336 | $self->producer($producer); |
337 | } else { |
338 | $producer = $self->producer; |
16dc9970 |
339 | } |
340 | |
1fd8c91f |
341 | # |
342 | # Execute the parser, then execute the producer with that output |
343 | # |
344 | my $translated = $parser->($args->{'data'}); |
345 | |
346 | return $producer->($translated); |
16dc9970 |
347 | } |
1fd8c91f |
348 | # }}} |
349 | |
350 | =head2 B<error> |
16dc9970 |
351 | |
1fd8c91f |
352 | The error method returns the last error. |
353 | |
354 | =cut |
355 | |
356 | # {{{ error |
16dc9970 |
357 | #----------------------------------------------------- |
1fd8c91f |
358 | sub error { |
16dc9970 |
359 | # |
1fd8c91f |
360 | # Return the last error. |
16dc9970 |
361 | # |
1fd8c91f |
362 | return shift()->{'error'} || ''; |
363 | } |
364 | # }}} |
365 | |
366 | =head2 B<error_out> |
367 | |
368 | Record the error and return undef. The error can be retrieved by |
369 | calling programs using $tr->error. |
370 | |
371 | For Parser or Producer writers, primarily. |
372 | |
373 | =cut |
374 | |
375 | # {{{ error_out |
376 | sub error_out { |
16dc9970 |
377 | my $self = shift; |
1fd8c91f |
378 | if ( my $error = shift ) { |
379 | $self->{'error'} = $error; |
16dc9970 |
380 | } |
1fd8c91f |
381 | return; |
16dc9970 |
382 | } |
1fd8c91f |
383 | # }}} |
16dc9970 |
384 | |
1fd8c91f |
385 | =head2 B<debug> |
386 | |
387 | If the global variable $SQL::Translator::DEBUG is set to a true value, |
388 | then calls to $tr->debug($msg) will be carped to STDERR. If $DEBUG is |
389 | not set, then this method does nothing. |
390 | |
391 | =cut |
392 | |
393 | # {{{ debug |
394 | use Carp qw(carp); |
395 | sub debug { |
16dc9970 |
396 | my $self = shift; |
1fd8c91f |
397 | carp @_ if ($DEBUG); |
16dc9970 |
398 | } |
1fd8c91f |
399 | # }}} |
400 | |
401 | # {{{ load |
402 | sub load { |
403 | my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" }; |
404 | return 1 if $INC{$module}; |
405 | |
406 | eval { require $module }; |
407 | |
408 | return if ($@); |
409 | return 1; |
410 | } |
411 | # }}} |
16dc9970 |
412 | |
413 | 1; |
414 | |
1fd8c91f |
415 | __END__ |
16dc9970 |
416 | #----------------------------------------------------- |
417 | # Rescue the drowning and tie your shoestrings. |
418 | # Henry David Thoreau |
419 | #----------------------------------------------------- |
420 | |
1fd8c91f |
421 | =head1 AUTHOR |
16dc9970 |
422 | |
1fd8c91f |
423 | Ken Y. Clark, E<lt>kclark@logsoft.comE<gt>, |
424 | darren chamberlain E<lt>darren@cpan.orgE<gt> |
16dc9970 |
425 | |
1fd8c91f |
426 | =head1 COPYRIGHT |
16dc9970 |
427 | |
1fd8c91f |
428 | This program is free software; you can redistribute it and/or modify |
429 | it under the terms of the GNU General Public License as published by |
430 | the Free Software Foundation; version 2. |
16dc9970 |
431 | |
1fd8c91f |
432 | This program is distributed in the hope that it will be useful, but |
433 | WITHOUT ANY WARRANTY; without even the implied warranty of |
434 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
435 | General Public License for more details. |
16dc9970 |
436 | |
1fd8c91f |
437 | You should have received a copy of the GNU General Public License |
438 | along with this program; if not, write to the Free Software |
439 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 |
440 | USA |
16dc9970 |
441 | |
442 | =head1 SEE ALSO |
443 | |
1fd8c91f |
444 | L<perl>, L<Parse::RecDescent> |
16dc9970 |
445 | |
446 | =cut |