1 package SQL::Translator;
3 #-----------------------------------------------------
4 # $Id: Translator.pm,v 1.3.2.2 2002-03-15 20:13:46 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;
32 $translator->parser("MySQL");
33 $translator->producer("Oracle");
35 my $output = $translator->translate($file) or die $translator->error;
40 This module attempts to simplify the task of converting one database
41 create syntax to another through the use of Parsers and Producers.
42 The idea is that any Parser can be used with any Producer in the
43 conversion process. So, if you wanted PostgreSQL-to-Oracle, you could
44 just write the PostgreSQL parser and use an existing Oracle producer.
46 Currently, the existing parsers use Parse::RecDescent, but this not
47 a requirement, or even a recommendation. New parser modules don't
48 necessarily have to use Parse::RecDescent, as long as the module
49 implements the appropriate API. With this separation of code, it is
50 hoped that developers will find it easy to add more database dialects
51 by using what's written, writing only what they need, and then
52 contributing their parsers or producers back to the project.
57 use vars qw($VERSION $DEFAULT_SUB $DEBUG);
58 $VERSION = sprintf "%d.%02d", q$Revision: 1.3.2.2 $ =~ /(\d+)\.(\d+)/;
59 $DEBUG = 1 unless defined $DEBUG;
61 $DEFAULT_SUB = sub { $_[0] } unless defined $DEFAULT_SUB;
63 *can = \&UNIVERSAL::can;
64 *isa = \&UNIVERSAL::isa;
68 The constructor is called B<new>, and accepts a optional hash of options.
73 =item parser (aka from)
75 =item producer (aka to)
81 All options are, well, optional; these attributes can be set via
90 my $args = isa($_[0], 'HASH') ? shift : { @_ };
91 my $self = bless { } => $class;
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
99 $self->parser( $args->{'parser'} || $args->{'from'} || $DEFAULT_SUB);
100 $self->producer($args->{'producer'} || $args->{'to'} || $DEFAULT_SUB);
105 $self->error_out("");
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 2 parameters: its encompassing SQL::Translator
120 instance and a data structure. It is expected that the function
121 transform the data structure to the output format, and return a
122 string. The SQL::Transformer instance is provided for informational
123 purposes; the type of the parser, for example, can be retrieved using
124 the B<parser_type> method, and the B<error> and B<debug> methods can
125 be called when needed.
127 When defining a producer, one of three things can be passed
128 in: A full module name (e.g., My::Groovy::Parser), a module name
129 relative to the SQL::Translator::Producer namespace (e.g., MySQL), or
130 a reference to an anonymous subroutine. If a full module name is
131 passed in, it is treated as a package, and a function called
132 "produce" will be invoked as $modulename::produce.
134 my $tr = SQL::Translator->new;
136 # This will invoke My::Groovy::Producer::produce($tr, $data)
137 $tr->producer("My::Groovy::Producer");
139 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
140 $tr->producer("Sybase");
142 # This will invoke the referenced subroutine directly, as
143 # $subref->($tr, $data);
144 $tr->producer(\&my_producer);
146 There is also a method named B<producer_type>, which is a string
147 containing the classname to which the above B<produce> function
148 belongs. In the case of anonymous subroutines, this method returns
153 # {{{ producer and producer_type
157 my $producer = shift;
158 if ($producer =~ /::/) {
160 if (load($producer)) {
161 $func_name = "produce";
163 # Oops! Passed Module::Name::function; try to recover
164 my @func_parts = split /::/, $producer;
165 $func_name = pop @func_parts;
166 $producer = join "::", @func_parts;
167 load($producer) or die "Can't load $producer: $@";
170 $self->{'producer'} = \&{ "$producer\::$func_name" };
171 $self->{'producer_type'} = $producer;
172 $self->debug("Got 'producer': $producer\::$func_name");
173 } elsif (isa($producer, 'CODE')) {
174 $self->{'producer'} = $producer;
175 $self->{'producer_type'} = "CODE";
176 $self->debug("Got 'producer': code ref");
178 my $Pp = sprintf "SQL::Translator::Producer::$producer";
179 load($Pp) or die "Can't load $Pp: $@";
180 $self->{'producer'} = \&{ "$Pp\::produce" };
181 $self->{'producer_type'} = $Pp;
182 $self->debug("Got producer: $Pp");
184 # At this point, $self->{'producer'} contains a subroutine
185 # reference that is ready to run!
187 return $self->{'producer'};
190 sub producer_type { $_[0]->{'producer_type'} }
195 The B<parser> method defines or retrieves a subroutine that will be
196 called to perform the parsing. The basic idea is the same as that of
197 B<producer> (see above), except the default subroutine name is
198 "parse", and will be invoked as $module_name::parse($tr, $data).
199 Also, the parser subroutine will be passed a string containing the
200 entirety of the data to be parsed (or possibly a reference to a string?).
202 # Invokes SQL::Translator::Parser::MySQL::parse()
203 $tr->parser("MySQL");
205 # Invokes My::Groovy::Parser::parse()
206 $tr->parser("My::Groovy::Parser");
208 # Invoke an anonymous subroutine directly
210 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
211 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
212 return $dumper->Dump;
217 # {{{ parser and parser_type
222 if ($parser =~ /::/) {
223 load($parser) or die "Can't load $parser: $@";
224 $self->{'parser'} = \&{ "$parser\::parse" };
225 $self->{'parser_type'} = $parser;
226 $self->debug("Got parser: $parser\::parse");
227 } elsif (isa($parser, 'CODE')) {
228 $self->{'parser'} = $parser;
229 $self->{'parser_type'} = "CODE";
230 $self->debug("Got parser: code ref");
232 my $Pp = "SQL::Translator::Parser::$parser";
233 load($Pp) or die "Can't load $Pp: $@";
234 $self->{'parser'} = \&{ "$Pp\::parse" };
235 $self->{'parser_type'} = $Pp;
236 $self->debug("Got parser: $Pp");
238 # At this point, $self->{$pp} contains a subroutine
239 # reference that is ready to run!
241 return $self->{'parser'};
244 sub parser_type { $_[0]->{'parser_type'} }
249 The B<translate> method calls the subroutines referenced by the
250 B<parser> and B<producer> data members (described above). It accepts
251 as arguments a number of things, in key => value format, including
252 (potentially) a parser and a producer (they are passed directly to the
253 B<parser> and B<producer> methods).
255 Here is how the parameter list to B<translate> is parsed:
261 1 argument means it's the data to be parsed; which could be a string
262 (filename), a reference to a GLOB (filehandle from which to read a
263 string), a refernce to a scalar (a string stored in memory), or a
264 reference to a hash (which means the same thing as below).
266 # Parse the file /path/to/datafile
267 my $output = $tr->translate("/path/to/datafile");
270 my $fh = IO::File->new("/path/to/datafile");
271 my $output = $tr->translate($fh);
273 # Again, the same thing:
274 my $fh = IO::File->new("/path/to/datafile");
275 my $data = { local $/; <$fh> };
276 my $output = $tr->translate(\$data);
280 More than 1 argument means its a hash of things, and it might be
281 setting a parser, producer, or datasource (this key is named
282 "filename" or "file" if it's a file, or "data" for a GLOB or
285 # As above, parse /path/to/datafile, but with different producers
286 for my $prod ("MySQL", "XML", "Sybase") {
287 print $tr->translate(
289 filename => "/path/to/datafile",
293 # The filename hash key could also be:
297 datasource => \$data,
308 my ($args, $parser, $producer);
311 if (isa($_[0], 'HASH')) {
313 $self->debug("translate: Got a hashref");
316 elsif (my $getlines = can($_[0], "getlines")) {
317 # passed a IO::Handle derivative
318 # XXX Something about this does not work!
319 # XXX look into how Template does this.
320 $self->debug("translate: Got a IO::Handle subclass (can getlines)");
323 my $data = join '', $fh->$getlines;
324 $args = { data => $data };
326 elsif (isa($_[0], 'GLOB')) {
327 # passed a filehandle; slurp it
328 $self->debug("translate: Got a GLOB");
330 $args = { data => <$_[0]> };
332 elsif (isa($_[0], 'SCALAR')) {
333 # passed a ref to a string; deref it
334 $self->debug("translate: Got a SCALAR reference (string)");
335 $args = { data => ${$_[0]} };
338 # Not a ref, it's a filename
339 $self->debug("translate: Got a filename");
340 $args = { filename => $_[0] };
344 # Should we check if @_ % 2, or just eat the errors if they occur?
348 if ((defined $args->{'filename'} ||
349 defined $args->{'file'} ) && not $args->{'data'}) {
353 open FH, $args->{'filename'} or die "Can't open $args->{'filename'}: $!";
354 $args->{'data'} = <FH>;
359 # Last chance to bail out; if there's nothing in the data
360 # key of %args, back out.
362 return unless defined $args->{'data'};
368 # Local reference to the parser subroutine
370 if ($parser = ($args->{'parser'} || $args->{'from'})) {
371 $self->parser($parser);
373 $parser = $self->parser;
377 # Local reference to the producer subroutine
379 if ($producer = ($args->{'producer'} || $args->{'to'})) {
380 $self->producer($producer);
382 $producer = $self->producer;
386 # Execute the parser, then execute the producer with that output
388 my $translated = $parser->($self, $args->{'data'});
390 return $producer->($self, $translated);
396 The error method returns the last error.
401 #-----------------------------------------------------
404 # Return the last error.
406 return shift()->{'error'} || '';
412 Record the error and return undef. The error can be retrieved by
413 calling programs using $tr->error.
415 For Parser or Producer writers, primarily.
422 if ( my $error = shift ) {
423 $self->{'error'} = $error;
431 If the global variable $SQL::Translator::DEBUG is set to a true value,
432 then calls to $tr->debug($msg) will be carped to STDERR. If $DEBUG is
433 not set, then this method does nothing.
447 my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
448 return 1 if $INC{$module};
450 eval { require $module };
460 #-----------------------------------------------------
461 # Rescue the drowning and tie your shoestrings.
462 # Henry David Thoreau
463 #-----------------------------------------------------
467 Ken Y. Clark, E<lt>kclark@logsoft.comE<gt>,
468 darren chamberlain E<lt>darren@cpan.orgE<gt>
472 This program is free software; you can redistribute it and/or modify
473 it under the terms of the GNU General Public License as published by
474 the Free Software Foundation; version 2.
476 This program is distributed in the hope that it will be useful, but
477 WITHOUT ANY WARRANTY; without even the implied warranty of
478 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
479 General Public License for more details.
481 You should have received a copy of the GNU General Public License
482 along with this program; if not, write to the Free Software
483 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
488 L<perl>, L<Parse::RecDescent>