1 package SQL::Translator;
3 # ----------------------------------------------------------------------
4 # $Id: Translator.pm,v 1.5 2002-03-26 12:46:54 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.5 $ =~ /(\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 # ------------------------------------------------------------------
129 # Set the parser_args and producer_args
130 # ------------------------------------------------------------------
131 for my $pargs (qw(parser_args producer_args)) {
132 $self->$pargs($args->{$pargs}) if defined $args->{$pargs};
135 # ------------------------------------------------------------------
137 # ------------------------------------------------------------------
138 $self->error_out("");
148 The B<producer> method is an accessor/mutator, used to retrieve or
149 define what subroutine is called to produce the output. A subroutine
150 defined as a producer will be invoked as a function (not a method) and
151 passed 2 parameters: its container SQL::Translator instance and a
152 data structure. It is expected that the function transform the data
153 structure to a string. The SQL::Transformer instance is provided for
154 informational purposes; for example, the type of the parser can be
155 retrieved using the B<parser_type> method, and the B<error> and
156 B<debug> methods can be called when needed.
158 When defining a producer, one of several things can be passed
159 in: A module name (e.g., My::Groovy::Producer), a module name
160 relative to the SQL::Translator::Producer namespace (e.g., MySQL), a
161 module name and function combination (My::Groovy::Producer::transmogrify),
162 or a reference to an anonymous subroutine. If a full module name is
163 passed in (for the purposes of this method, a string containing "::"
164 is considered to be a module name), it is treated as a package, and a
165 function called "produce" will be invoked: $modulename::produce. If
166 $modulename cannot be loaded, the final portion is stripped off and
167 treated as a function. In other words, if there is no file named
168 My/Groovy/Producer/transmogrify.pm, SQL::Translator will attempt to load
169 My/Groovy/Producer.pm and use transmogrify as the name of the function,
170 instead of the default "produce".
172 my $tr = SQL::Translator->new;
174 # This will invoke My::Groovy::Producer::produce($tr, $data)
175 $tr->producer("My::Groovy::Producer");
177 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
178 $tr->producer("Sybase");
180 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
181 # assuming that My::Groovy::Producer::transmogrify is not a module
183 $tr->producer("My::Groovy::Producer::transmogrify");
185 # This will invoke the referenced subroutine directly, as
186 # $subref->($tr, $data);
187 $tr->producer(\&my_producer);
189 There is also a method named B<producer_type>, which is a string
190 containing the classname to which the above B<produce> function
191 belongs. In the case of anonymous subroutines, this method returns
194 Finally, there is a method named B<producer_args>, which is both an
195 accessor and a mutator. Arbitrary data may be stored in name => value
196 pairs for the producer subroutine to access:
198 sub My::Random::producer {
199 my ($tr, $data) = @_;
200 my $pr_args = $tr->producer_args();
202 # $pr_args is a hashref.
204 Extra data passed to the B<producer> method is passed to
207 $tr->producer("xSV", delimiter => ',\s*');
209 # In SQL::Translator::Producer::xSV:
210 my $args = $tr->producer_args;
211 my $delimiter = $args->{'delimiter'}; # value is => ,\s*
215 # {{{ producer and producer_type
219 # {{{ producer as a mutator
221 my $producer = shift;
223 # {{{ Passed a module name (string containing "::")
224 if ($producer =~ /::/) {
227 # {{{ Module name was passed directly
228 # We try to load the name; if it doesn't load, there's
229 # a possibility that it has a function name attached to
231 if (load($producer)) {
232 $func_name = "produce";
235 # {{{ Module::function was passed
237 # Passed Module::Name::function; try to recover
238 my @func_parts = split /::/, $producer;
239 $func_name = pop @func_parts;
240 $producer = join "::", @func_parts;
242 # If this doesn't work, then we have a legitimate
244 load($producer) or die "Can't load $producer: $@";
247 # {{{ get code reference and assign
248 $self->{'producer'} = \&{ "$producer\::$func_name" };
249 $self->{'producer_type'} = $producer;
250 $self->debug("Got producer: $producer\::$func_name");
254 # {{{ passed an anonymous subroutine reference
255 elsif (isa($producer, 'CODE')) {
256 $self->{'producer'} = $producer;
257 $self->{'producer_type'} = "CODE";
258 $self->debug("Got 'producer': code ref");
261 # {{{ passed a string containing no "::"; relative package name
263 my $Pp = sprintf "SQL::Translator::Producer::$producer";
264 load($Pp) or die "Can't load $Pp: $@";
265 $self->{'producer'} = \&{ "$Pp\::produce" };
266 $self->{'producer_type'} = $Pp;
267 $self->debug("Got producer: $Pp");
270 # At this point, $self->{'producer'} contains a subroutine
271 # reference that is ready to run
273 # {{{ Anything left? If so, it's producer_args
274 $self->produser_args(@_) if (@_);
278 return $self->{'producer'};
282 # producer_type is an accessor that allows producer subs to get
283 # information about their origin. This is poptentially important;
284 # since all producer subs are called as subroutine refernces, there is
285 # no way for a producer to find out which package the sub lives in
286 # originally, for example.
287 sub producer_type { $_[0]->{'producer_type'} } # }}}
290 # Arbitrary name => value pairs of paramters can be passed to a
291 # producer using this method.
295 my $args = isa($_[0], 'HASH') ? shift : { @_ };
296 $self->{'producer_args'} = $args;
298 $self->{'producer_args'};
304 The B<parser> method defines or retrieves a subroutine that will be
305 called to perform the parsing. The basic idea is the same as that of
306 B<producer> (see above), except the default subroutine name is
307 "parse", and will be invoked as $module_name::parse($tr, $data).
308 Also, the parser subroutine will be passed a string containing the
309 entirety of the data to be parsed (or possibly a reference to a string?).
311 # Invokes SQL::Translator::Parser::MySQL::parse()
312 $tr->parser("MySQL");
314 # Invokes My::Groovy::Parser::parse()
315 $tr->parser("My::Groovy::Parser");
317 # Invoke an anonymous subroutine directly
319 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
320 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
321 return $dumper->Dump;
324 There is also B<parser_type> and B<parser_args>, which perform
325 analogously to B<producer_type> and B<producer_args>
329 # {{{ parser, parser_type, and parser_args
333 # {{{ parser as a mutator
337 # {{{ Passed a module name (string containing "::")
338 if ($parser =~ /::/) {
341 # {{{ Module name was passed directly
342 # We try to load the name; if it doesn't load, there's
343 # a possibility that it has a function name attached to
346 $func_name = "parse";
349 # {{{ Module::function was passed
351 # Passed Module::Name::function; try to recover
352 my @func_parts = split /::/, $parser;
353 $func_name = pop @func_parts;
354 $parser = join "::", @func_parts;
356 # If this doesn't work, then we have a legitimate
358 load($parser) or die "Can't load $parser: $@";
361 # {{{ get code reference and assign
362 $self->{'parser'} = \&{ "$parser\::$func_name" };
363 $self->{'parser_type'} = $parser;
364 $self->debug("Got parser: $parser\::$func_name");
368 # {{{ passed an anonymous subroutine reference
369 elsif (isa($parser, 'CODE')) {
370 $self->{'parser'} = $parser;
371 $self->{'parser_type'} = "CODE";
372 $self->debug("Got 'parser': code ref");
375 # {{{ passed a string containing no "::"; relative package name
377 my $Pp = sprintf "SQL::Translator::Parser::$parser";
378 load($Pp) or die "Can't load $Pp: $@";
379 $self->{'parser'} = \&{ "$Pp\::parse" };
380 $self->{'parser_type'} = $Pp;
381 $self->debug("Got parser: $Pp");
384 # At this point, $self->{'parser'} contains a subroutine
385 # reference that is ready to run
387 $self->parser_args(@_) if (@_);
390 return $self->{'parser'};
393 sub parser_type { $_[0]->{'parser_type'} }
399 my $args = isa($_[0], 'HASH') ? shift : { @_ };
400 $self->{'parser_args'} = $args;
402 $self->{'parser_args'};
408 The B<translate> method calls the subroutines referenced by the
409 B<parser> and B<producer> data members (described above). It accepts
410 as arguments a number of things, in key => value format, including
411 (potentially) a parser and a producer (they are passed directly to the
412 B<parser> and B<producer> methods).
414 Here is how the parameter list to B<translate> is parsed:
420 1 argument means it's the data to be parsed; which could be a string
421 (filename) or a refernce to a scalar (a string stored in memory), or a
422 reference to a hash, which is parsed as being more than one argument
425 # Parse the file /path/to/datafile
426 my $output = $tr->translate("/path/to/datafile");
428 # Parse the data contained in the string $data
429 my $output = $tr->translate(\$data);
433 More than 1 argument means its a hash of things, and it might be
434 setting a parser, producer, or datasource (this key is named
435 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
437 # As above, parse /path/to/datafile, but with different producers
438 for my $prod ("MySQL", "XML", "Sybase") {
439 print $tr->translate(
441 filename => "/path/to/datafile",
445 # The filename hash key could also be:
446 datasource => \$data,
457 my ($args, $parser, $producer);
460 if (isa($_[0], 'HASH')) {
462 $self->debug("translate: Got a hashref");
465 elsif (isa($_[0], 'SCALAR')) {
466 # passed a ref to a string; deref it
467 $self->debug("translate: Got a SCALAR reference (string)");
468 $args = { data => ${$_[0]} };
470 elsif (! ref $_[0]) {
471 # Not a ref, it's a filename
472 $self->debug("translate: Got a filename");
473 $args = { filename => $_[0] };
476 # We're not impressed. Take your empty string and leave.
481 # You must pass in a hash, or you get nothing.
486 if ((defined $args->{'filename'} || defined $args->{'file'}) &&
487 not $args->{'data'}) {
491 open FH, $args->{'filename'}
492 or die "Can't open $args->{'filename'} for reading: $!";
493 $args->{'data'} = <FH>;
494 close FH or die "Can't close $args->{'filename'}: $!";
498 # Last chance to bail out; if there's nothing in the data
499 # key of %args, back out.
501 return "" unless defined $args->{'data'};
504 # Local reference to the parser subroutine
506 if ($parser = ($args->{'parser'} || $args->{'from'})) {
507 $self->parser($parser);
509 $parser = $self->parser;
513 # Local reference to the producer subroutine
515 if ($producer = ($args->{'producer'} || $args->{'to'})) {
516 $self->producer($producer);
518 $producer = $self->producer;
522 # Execute the parser, then execute the producer with that output
524 return $producer->($self, $parser->($self, $args->{'data'}));
530 The error method returns the last error.
535 #-----------------------------------------------------
538 # Return the last error.
540 return shift()->{'error'} || '';
546 Record the error and return undef. The error can be retrieved by
547 calling programs using $tr->error.
549 For Parser or Producer writers, primarily.
556 if ( my $error = shift ) {
557 $self->{'error'} = $error;
565 If the global variable $SQL::Translator::DEBUG is set to a true value,
566 then calls to $tr->debug($msg) will be carped to STDERR. If $DEBUG is
567 not set, then this method does nothing.
580 my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
581 return 1 if $INC{$module};
583 eval { require $module };
593 #-----------------------------------------------------
594 # Rescue the drowning and tie your shoestrings.
595 # Henry David Thoreau
596 #-----------------------------------------------------
600 Ken Y. Clark, E<lt>kclark@logsoft.comE<gt>,
601 darren chamberlain E<lt>darren@cpan.orgE<gt>
605 This program is free software; you can redistribute it and/or modify
606 it under the terms of the GNU General Public License as published by
607 the Free Software Foundation; version 2.
609 This program is distributed in the hope that it will be useful, but
610 WITHOUT ANY WARRANTY; without even the implied warranty of
611 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
612 General Public License for more details.
614 You should have received a copy of the GNU General Public License
615 along with this program; if not, write to the Free Software
616 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
621 L<perl>, L<Parse::RecDescent>