1 package SQL::Translator;
3 # ----------------------------------------------------------------------
4 # $Id: Translator.pm,v 1.3.2.3 2002-03-18 20:35:51 dlc Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
7 # darren chamberlain <darren@cpan.org>
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.
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.
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
22 # -------------------------------------------------------------------
26 SQL::Translator - convert schema from one database to another
31 my $translator = SQL::Translator->new;
33 my $output = $translator->translate(
37 ) or die $translator->error;
42 This module attempts to simplify the task of converting one database
43 create syntax to another through the use of Parsers and Producers.
44 The idea is that any Parser can be used with any Producer in the
45 conversion process. So, if you wanted PostgreSQL-to-Oracle, you would
46 use the PostgreSQL parser and the Oracle producer.
48 Currently, the existing parsers use Parse::RecDescent, but this not
49 a requirement, or even a recommendation. New parser modules don't
50 necessarily have to use Parse::RecDescent, as long as the module
51 implements the appropriate API. 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.
59 use vars qw($VERSION $DEFAULT_SUB $DEBUG);
60 $VERSION = sprintf "%d.%02d", q$Revision: 1.3.2.3 $ =~ /(\d+)\.(\d+)/;
61 $DEBUG = 1 unless defined $DEBUG;
63 # ----------------------------------------------------------------------
64 # The default behavior is to "pass through" values (note that the
65 # SQL::Translator instance is the first value ($_[0]), and the stuff
66 # to be parsed is the second value ($_[1])
67 # ----------------------------------------------------------------------
68 $DEFAULT_SUB = sub { $_[1] } unless defined $DEFAULT_SUB;
70 *isa = \&UNIVERSAL::isa;
76 The constructor is called B<new>, and accepts a optional hash of options.
81 =item parser (aka from)
83 =item producer (aka to)
89 All options are, well, optional; these attributes can be set via
90 instance methods. Internally, they are; no (non-syntactical)
91 advantage is gained by passing options to the constructor.
96 # ----------------------------------------------------------------------
100 # new takes an optional hash of arguments. These arguments may
101 # include a parser, specified with the keys "parser" or "from",
102 # and a producer, specified with the keys "producer" or "to".
104 # The values that can be passed as the parser or producer are
105 # given directly to the parser or producer methods, respectively.
106 # See the appropriate method description below for details about
107 # what each expects/accepts.
110 # * Support passing an input (filename or string) as with
112 # ----------------------------------------------------------------------
115 my $args = isa($_[0], 'HASH') ? shift : { @_ };
116 my $self = bless { } => $class;
118 # ------------------------------------------------------------------
119 # Set the parser and producer.
121 # If a 'parser' or 'from' parameter is passed in, use that as the
122 # parser; if a 'producer' or 'to' parameter is passed in, use that
123 # as the producer; both default to $DEFAULT_SUB.
124 # ------------------------------------------------------------------
125 $self->parser( $args->{'parser'} || $args->{'from'} || $DEFAULT_SUB);
126 $self->producer($args->{'producer'} || $args->{'to'} || $DEFAULT_SUB);
128 # ------------------------------------------------------------------
130 # ------------------------------------------------------------------
131 $self->error_out("");
141 The B<producer> method is an accessor/mutator, used to retrieve or
142 define what subroutine is called to produce the output. A subroutine
143 defined as a producer will be invoked as a function (not a method) and
144 passed 2 parameters: its container SQL::Translator instance and a
145 data structure. It is expected that the function transform the data
146 structure to a string. The SQL::Transformer instance is provided for
147 informational purposes; for example, the type of the parser can be
148 retrieved using the B<parser_type> method, and the B<error> and
149 B<debug> methods can be called when needed.
151 When defining a producer, one of several things can be passed
152 in: A module name (e.g., My::Groovy::Producer), a module name
153 relative to the SQL::Translator::Producer namespace (e.g., MySQL), a
154 module name and function combination (My::Groovy::Producer::transmogrify),
155 or a reference to an anonymous subroutine. If a full module name is
156 passed in (for the purposes of this method, a string containing "::"
157 is considered to be a module name), it is treated as a package, and a
158 function called "produce" will be invoked: $modulename::produce. If
159 $modulename cannot be loaded, the final portion is stripped off and
160 treated as a function. In other words, if there is no file named
161 My/Groovy/Producer/transmogrify.pm, SQL::Translator will attempt to load
162 My/Groovy/Producer.pm and use transmogrify as the name of the function,
163 instead of the default "produce".
165 my $tr = SQL::Translator->new;
167 # This will invoke My::Groovy::Producer::produce($tr, $data)
168 $tr->producer("My::Groovy::Producer");
170 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
171 $tr->producer("Sybase");
173 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
174 # assuming that My::Groovy::Producer::transmogrify is not a module
176 # $tr->producer("My::Groovy::Producer::transmogrify);
178 # This will invoke the referenced subroutine directly, as
179 # $subref->($tr, $data);
180 $tr->producer(\&my_producer);
182 There is also a method named B<producer_type>, which is a string
183 containing the classname to which the above B<produce> function
184 belongs. In the case of anonymous subroutines, this method returns
189 # {{{ producer and producer_type
193 # {{{ producer as a mutator
195 my $producer = shift;
197 # {{{ Passed a module name (string containing "::")
198 if ($producer =~ /::/) {
201 # {{{ Module name was passed directly
202 # We try to load the name; if it doesn't load, there's
203 # a possibility that it has a function name attached to
205 if (load($producer)) {
206 $func_name = "produce";
209 # {{{ Module::function was passed
211 # Passed Module::Name::function; try to recover
212 my @func_parts = split /::/, $producer;
213 $func_name = pop @func_parts;
214 $producer = join "::", @func_parts;
216 # If this doesn't work, then we have a legitimate
218 load($producer) or die "Can't load $producer: $@";
221 # {{{ get code reference and assign
222 $self->{'producer'} = \&{ "$producer\::$func_name" };
223 $self->{'producer_type'} = $producer;
224 $self->debug("Got 'producer': $producer\::$func_name");
228 # {{{ passed an anonymous subroutine reference
229 elsif (isa($producer, 'CODE')) {
230 $self->{'producer'} = $producer;
231 $self->{'producer_type'} = "CODE";
232 $self->debug("Got 'producer': code ref");
235 # {{{ passed a string containing no "::"; relative package name
237 my $Pp = sprintf "SQL::Translator::Producer::$producer";
238 load($Pp) or die "Can't load $Pp: $@";
239 $self->{'producer'} = \&{ "$Pp\::produce" };
240 $self->{'producer_type'} = $Pp;
241 $self->debug("Got producer: $Pp");
244 # At this point, $self->{'producer'} contains a subroutine
245 # reference that is ready to run
248 return $self->{'producer'};
251 sub producer_type { $_[0]->{'producer_type'} }
256 The B<parser> method defines or retrieves a subroutine that will be
257 called to perform the parsing. The basic idea is the same as that of
258 B<producer> (see above), except the default subroutine name is
259 "parse", and will be invoked as $module_name::parse($tr, $data).
260 Also, the parser subroutine will be passed a string containing the
261 entirety of the data to be parsed (or possibly a reference to a string?).
263 # Invokes SQL::Translator::Parser::MySQL::parse()
264 $tr->parser("MySQL");
266 # Invokes My::Groovy::Parser::parse()
267 $tr->parser("My::Groovy::Parser");
269 # Invoke an anonymous subroutine directly
271 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
272 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
273 return $dumper->Dump;
278 # {{{ parser and parser_type
282 # {{{ parser as a mutator
286 # {{{ Passed a module name (string containing "::")
287 if ($parser =~ /::/) {
290 # {{{ Module name was passed directly
291 # We try to load the name; if it doesn't load, there's
292 # a possibility that it has a function name attached to
295 $func_name = "parse";
298 # {{{ Module::function was passed
300 # Passed Module::Name::function; try to recover
301 my @func_parts = split /::/, $parser;
302 $func_name = pop @func_parts;
303 $parser = join "::", @func_parts;
305 # If this doesn't work, then we have a legitimate
307 load($parser) or die "Can't load $parser: $@";
310 # {{{ get code reference and assign
311 $self->{'parser'} = \&{ "$parser\::$func_name" };
312 $self->{'parser_type'} = $parser;
313 $self->debug("Got parser: $parser\::$func_name");
317 # {{{ passed an anonymous subroutine reference
318 elsif (isa($parser, 'CODE')) {
319 $self->{'parser'} = $parser;
320 $self->{'parser_type'} = "CODE";
321 $self->debug("Got 'parser': code ref");
324 # {{{ passed a string containing no "::"; relative package name
326 my $Pp = sprintf "SQL::Translator::Parser::$parser";
327 load($Pp) or die "Can't load $Pp: $@";
328 $self->{'parser'} = \&{ "$Pp\::parse" };
329 $self->{'parser_type'} = $Pp;
330 $self->debug("Got parser: $Pp");
333 # At this point, $self->{'parser'} contains a subroutine
334 # reference that is ready to run
338 return $self->{'parser'};
341 sub parser_type { $_[0]->{'parser_type'} }
346 The B<translate> method calls the subroutines referenced by the
347 B<parser> and B<producer> data members (described above). It accepts
348 as arguments a number of things, in key => value format, including
349 (potentially) a parser and a producer (they are passed directly to the
350 B<parser> and B<producer> methods).
352 Here is how the parameter list to B<translate> is parsed:
358 1 argument means it's the data to be parsed; which could be a string
359 (filename) or a refernce to a scalar (a string stored in memory), or a
360 reference to a hash, which is parsed as being more than one argument
363 # Parse the file /path/to/datafile
364 my $output = $tr->translate("/path/to/datafile");
366 # Parse the data contained in the string $data
367 my $output = $tr->translate(\$data);
371 More than 1 argument means its a hash of things, and it might be
372 setting a parser, producer, or datasource (this key is named
373 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
375 # As above, parse /path/to/datafile, but with different producers
376 for my $prod ("MySQL", "XML", "Sybase") {
377 print $tr->translate(
379 filename => "/path/to/datafile",
383 # The filename hash key could also be:
384 datasource => \$data,
395 my ($args, $parser, $producer);
398 if (isa($_[0], 'HASH')) {
400 $self->debug("translate: Got a hashref");
403 elsif (isa($_[0], 'SCALAR')) {
404 # passed a ref to a string; deref it
405 $self->debug("translate: Got a SCALAR reference (string)");
406 $args = { data => ${$_[0]} };
408 elsif (! ref $_[0]) {
409 # Not a ref, it's a filename
410 $self->debug("translate: Got a filename");
411 $args = { filename => $_[0] };
414 # We're not impressed. Take your empty string and leave.
419 # You must pass in a hash, or you get nothing.
424 if ((defined $args->{'filename'} || defined $args->{'file'}) &&
425 not $args->{'data'}) {
429 open FH, $args->{'filename'}
430 or die "Can't open $args->{'filename'} for reading: $!";
431 $args->{'data'} = <FH>;
432 close FH or die "Can't close $args->{'filename'}: $!";
436 # Last chance to bail out; if there's nothing in the data
437 # key of %args, back out.
439 return "" unless defined $args->{'data'};
442 # Local reference to the parser subroutine
444 if ($parser = ($args->{'parser'} || $args->{'from'})) {
445 $self->parser($parser);
447 $parser = $self->parser;
451 # Local reference to the producer subroutine
453 if ($producer = ($args->{'producer'} || $args->{'to'})) {
454 $self->producer($producer);
456 $producer = $self->producer;
460 # Execute the parser, then execute the producer with that output
462 return $producer->($self, $parser->($self, $args->{'data'}));
468 The error method returns the last error.
473 #-----------------------------------------------------
476 # Return the last error.
478 return shift()->{'error'} || '';
484 Record the error and return undef. The error can be retrieved by
485 calling programs using $tr->error.
487 For Parser or Producer writers, primarily.
494 if ( my $error = shift ) {
495 $self->{'error'} = $error;
503 If the global variable $SQL::Translator::DEBUG is set to a true value,
504 then calls to $tr->debug($msg) will be carped to STDERR. If $DEBUG is
505 not set, then this method does nothing.
518 my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
519 return 1 if $INC{$module};
521 eval { require $module };
531 #-----------------------------------------------------
532 # Rescue the drowning and tie your shoestrings.
533 # Henry David Thoreau
534 #-----------------------------------------------------
538 Ken Y. Clark, E<lt>kclark@logsoft.comE<gt>,
539 darren chamberlain E<lt>darren@cpan.orgE<gt>
543 This program is free software; you can redistribute it and/or modify
544 it under the terms of the GNU General Public License as published by
545 the Free Software Foundation; version 2.
547 This program is distributed in the hope that it will be useful, but
548 WITHOUT ANY WARRANTY; without even the implied warranty of
549 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
550 General Public License for more details.
552 You should have received a copy of the GNU General Public License
553 along with this program; if not, write to the Free Software
554 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
559 L<perl>, L<Parse::RecDescent>