1 package SQL::Translator;
3 #-----------------------------------------------------
4 # $Id: Translator.pm,v 1.3.2.1 2002-03-07 14:14:48 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 my $output = $translator->translate(
36 ) or die $translator->error;
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.
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.
59 use vars qw($VERSION $DEFAULT_SUB $DEBUG);
60 $VERSION = sprintf "%d.%02d", q$Revision: 1.3.2.1 $ =~ /(\d+)\.(\d+)/;
61 $DEBUG = 1 unless defined $DEBUG;
63 $DEFAULT_SUB = sub { $_[0] } unless defined $DEFAULT_SUB;
64 *isa = \&UNIVERSAL::isa;
68 The constructor is called B<new>, and accepts a 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 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.
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.
130 my $tr = SQL::Translator->new;
132 # This will invoke My::Groovy::Producer::transform($data)
133 $tr->producer("My::Groovy::Producer");
135 # This will invoke SQL::Translator::Producer::Sybase::transform($data)
136 $tr->producer("Sybase");
138 # This will inoke the referenced subroutine directly
139 $tr->producer(\&my_producer);
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.
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");
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");
165 # At this point, $self->{'producer'} contains a subroutine
166 # reference that is ready to run!
168 return $self->{'producer'};
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
181 # Invokes SQL::Translator::Parser::MySQL::parse()
182 $tr->parser("MySQL");
184 # Invokes My::Groovy::Parser::parse()
185 $tr->parser("My::Groovy::Parser");
187 # Invoke an anonymous subroutine directly
189 my $dumper = Data::Dumper->new([ $_[0] ], [ "SQL" ]);
190 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
191 return $dumper->Dump;
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");
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");
214 # At this point, $self->{$pp} contains a subroutine
215 # reference that is ready to run!
217 return $self->{'parser'};
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).
229 Here is how the parameter list to B<translate> is parsed:
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).
240 # Parse the file /path/to/datafile
241 my $output = $tr->translate("/path/to/datafile");
244 my $fh = IO::File->new("/path/to/datafile");
245 my $output = $tr->translate($fh);
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);
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).
258 # As above, parse /path/to/datafile, but with different producers
259 for my $prod ("MySQL", "XML", "Sybase") {
260 print $tr->translate(
262 filename => "/path/to/datafile",
266 # The filename hash key could also be:
270 datasource => \$data,
281 my ($args, $parser, $producer);
284 if (isa($_[0], 'HASH')) {
288 elsif (isa($_[0], 'GLOB')) {
289 # passed a filehandle; slurp it
291 $args = { data => <$_[0]> };
293 elsif (isa($_[0], 'SCALAR')) {
294 # passed a ref to a string; deref it
295 $args = { data => ${$_[0]} };
298 # Not a ref, it's a filename
299 $args = { filename => $_[0] };
303 # Should we check if @_ % 2, or just eat the errors if they occur?
307 if ((defined $args->{'filename'} ||
308 defined $args->{'file'} ) && not $args->{'data'}) {
312 open FH, $args->{'filename'} or die $!;
313 $args->{'data'} = <FH>;
318 # Last chance to bail out; if there's nothing in the data
319 # key of %args, back out.
321 return unless defined $args->{'data'};
324 # Local reference to the parser subroutine
326 if ($parser = ($args->{'parser'} || $args->{'from'})) {
327 $self->parser($parser);
329 $parser = $self->parser;
333 # Local reference to the producer subroutine
335 if ($producer = ($args->{'producer'} || $args->{'to'})) {
336 $self->producer($producer);
338 $producer = $self->producer;
342 # Execute the parser, then execute the producer with that output
344 my $translated = $parser->($args->{'data'});
346 return $producer->($translated);
352 The error method returns the last error.
357 #-----------------------------------------------------
360 # Return the last error.
362 return shift()->{'error'} || '';
368 Record the error and return undef. The error can be retrieved by
369 calling programs using $tr->error.
371 For Parser or Producer writers, primarily.
378 if ( my $error = shift ) {
379 $self->{'error'} = $error;
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.
403 my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
404 return 1 if $INC{$module};
406 eval { require $module };
416 #-----------------------------------------------------
417 # Rescue the drowning and tie your shoestrings.
418 # Henry David Thoreau
419 #-----------------------------------------------------
423 Ken Y. Clark, E<lt>kclark@logsoft.comE<gt>,
424 darren chamberlain E<lt>darren@cpan.orgE<gt>
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.
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.
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
444 L<perl>, L<Parse::RecDescent>