1 package SQL::Translator;
3 # ----------------------------------------------------------------------
4 # $Id: Translator.pm,v 1.8 2002-07-08 14:42:56 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 (which understand
44 the sourced format) and Producers (which understand the destination
45 format). The idea is that any Parser can be used with any Producer in
46 the conversion process. So, if you wanted PostgreSQL-to-Oracle, you
47 would use the PostgreSQL parser and the Oracle producer.
52 use vars qw($VERSION $DEFAULT_SUB $DEBUG);
53 $VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
54 $DEBUG = 1 unless defined $DEBUG;
56 # ----------------------------------------------------------------------
57 # The default behavior is to "pass through" values (note that the
58 # SQL::Translator instance is the first value ($_[0]), and the stuff
59 # to be parsed is the second value ($_[1])
60 # ----------------------------------------------------------------------
61 $DEFAULT_SUB = sub { $_[1] } unless defined $DEFAULT_SUB;
63 *isa = \&UNIVERSAL::isa;
69 The constructor is called B<new>, and accepts a optional hash of options.
74 =item parser (aka from)
78 =item producer (aka to)
82 =item filename (aka file)
90 All options are, well, optional; these attributes can be set via
91 instance methods. Internally, they are; no (non-syntactical)
92 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.
108 # ----------------------------------------------------------------------
111 my $args = $_[0] && isa($_[0], 'HASH') ? shift : { @_ };
112 my $self = bless { } => $class;
114 # ------------------------------------------------------------------
115 # Set the parser and producer.
117 # If a 'parser' or 'from' parameter is passed in, use that as the
118 # parser; if a 'producer' or 'to' parameter is passed in, use that
119 # as the producer; both default to $DEFAULT_SUB.
120 # ------------------------------------------------------------------
121 $self->parser( $args->{'parser'} || $args->{'from'} || $DEFAULT_SUB);
122 $self->producer($args->{'producer'} || $args->{'to'} || $DEFAULT_SUB);
124 # ------------------------------------------------------------------
125 # Set the parser_args and producer_args
126 # ------------------------------------------------------------------
127 for my $pargs (qw(parser_args producer_args)) {
128 $self->$pargs($args->{$pargs}) if defined $args->{$pargs};
131 # ------------------------------------------------------------------
132 # Set the data source, if 'filename' or 'file' is provided.
133 # ------------------------------------------------------------------
134 $args->{'filename'} ||= $args->{'file'} || "";
135 $self->filename($args->{'filename'}) if $args->{'filename'};
137 # ------------------------------------------------------------------
138 # Finally, if there is a 'data' parameter, use that in preference
139 # to filename and file
140 # ------------------------------------------------------------------
141 if (my $data = $args->{'data'}) {
145 $self->{'debug'} = $DEBUG;
146 $self->{'debug'} = $args->{'debug'} if (defined $args->{'debug'});
148 # ------------------------------------------------------------------
150 # ------------------------------------------------------------------
151 $self->error_out("");
160 The B<producer> method is an accessor/mutator, used to retrieve or
161 define what subroutine is called to produce the output. A subroutine
162 defined as a producer will be invoked as a function (not a method) and
163 passed 2 parameters: its container SQL::Translator instance and a
164 data structure. It is expected that the function transform the data
165 structure to a string. The SQL::Transformer instance is provided for
166 informational purposes; for example, the type of the parser can be
167 retrieved using the B<parser_type> method, and the B<error> and
168 B<debug> methods can be called when needed.
170 When defining a producer, one of several things can be passed
171 in: A module name (e.g., My::Groovy::Producer), a module name
172 relative to the SQL::Translator::Producer namespace (e.g., MySQL), a
173 module name and function combination (My::Groovy::Producer::transmogrify),
174 or a reference to an anonymous subroutine. If a full module name is
175 passed in (for the purposes of this method, a string containing "::"
176 is considered to be a module name), it is treated as a package, and a
177 function called "produce" will be invoked: $modulename::produce. If
178 $modulename cannot be loaded, the final portion is stripped off and
179 treated as a function. In other words, if there is no file named
180 My/Groovy/Producer/transmogrify.pm, SQL::Translator will attempt to load
181 My/Groovy/Producer.pm and use transmogrify as the name of the function,
182 instead of the default "produce".
184 my $tr = SQL::Translator->new;
186 # This will invoke My::Groovy::Producer::produce($tr, $data)
187 $tr->producer("My::Groovy::Producer");
189 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
190 $tr->producer("Sybase");
192 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
193 # assuming that My::Groovy::Producer::transmogrify is not a module
195 $tr->producer("My::Groovy::Producer::transmogrify");
197 # This will invoke the referenced subroutine directly, as
198 # $subref->($tr, $data);
199 $tr->producer(\&my_producer);
201 There is also a method named B<producer_type>, which is a string
202 containing the classname to which the above B<produce> function
203 belongs. In the case of anonymous subroutines, this method returns
206 Finally, there is a method named B<producer_args>, which is both an
207 accessor and a mutator. Arbitrary data may be stored in name => value
208 pairs for the producer subroutine to access:
210 sub My::Random::producer {
211 my ($tr, $data) = @_;
212 my $pr_args = $tr->producer_args();
214 # $pr_args is a hashref.
216 Extra data passed to the B<producer> method is passed to
219 $tr->producer("xSV", delimiter => ',\s*');
221 # In SQL::Translator::Producer::xSV:
222 my $args = $tr->producer_args;
223 my $delimiter = $args->{'delimiter'}; # value is ,\s*
227 # producer and producer_type
231 # producer as a mutator
233 my $producer = shift;
235 # Passed a module name (string containing "::")
236 if ($producer =~ /::/) {
239 # Module name was passed directly
240 # We try to load the name; if it doesn't load, there's
241 # a possibility that it has a function name attached to
243 if (load($producer)) {
244 $func_name = "produce";
247 # Module::function was passed
249 # Passed Module::Name::function; try to recover
250 my @func_parts = split /::/, $producer;
251 $func_name = pop @func_parts;
252 $producer = join "::", @func_parts;
254 # If this doesn't work, then we have a legitimate
256 load($producer) or die "Can't load $producer: $@";
259 # get code reference and assign
260 $self->{'producer'} = \&{ "$producer\::$func_name" };
261 $self->{'producer_type'} = $producer;
262 $self->debug("Got producer: $producer\::$func_name");
265 # passed an anonymous subroutine reference
266 elsif (isa($producer, 'CODE')) {
267 $self->{'producer'} = $producer;
268 $self->{'producer_type'} = "CODE";
269 $self->debug("Got producer: code ref");
272 # passed a string containing no "::"; relative package name
274 my $Pp = sprintf "SQL::Translator::Producer::$producer";
275 load($Pp) or die "Can't load $Pp: $@";
276 $self->{'producer'} = \&{ "$Pp\::produce" };
277 $self->{'producer_type'} = $Pp;
278 $self->debug("Got producer: $Pp");
281 # At this point, $self->{'producer'} contains a subroutine
282 # reference that is ready to run
284 # Anything left? If so, it's producer_args
285 $self->producer_args(@_) if (@_);
288 return $self->{'producer'};
291 # ----------------------------------------------------------------------
294 # producer_type is an accessor that allows producer subs to get
295 # information about their origin. This is poptentially important;
296 # since all producer subs are called as subroutine refernces, there is
297 # no way for a producer to find out which package the sub lives in
298 # originally, for example.
299 # ----------------------------------------------------------------------
300 sub producer_type { $_[0]->{'producer_type'} }
302 # ----------------------------------------------------------------------
305 # Arbitrary name => value pairs of paramters can be passed to a
306 # producer using this method.
307 # ----------------------------------------------------------------------
311 my $args = isa($_[0], 'HASH') ? shift : { @_ };
312 $self->{'producer_args'} = $args;
314 $self->{'producer_args'};
319 The B<parser> method defines or retrieves a subroutine that will be
320 called to perform the parsing. The basic idea is the same as that of
321 B<producer> (see above), except the default subroutine name is
322 "parse", and will be invoked as $module_name::parse($tr, $data).
323 Also, the parser subroutine will be passed a string containing the
324 entirety of the data to be parsed (or possibly a reference to a string?).
326 # Invokes SQL::Translator::Parser::MySQL::parse()
327 $tr->parser("MySQL");
329 # Invokes My::Groovy::Parser::parse()
330 $tr->parser("My::Groovy::Parser");
332 # Invoke an anonymous subroutine directly
334 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
335 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
336 return $dumper->Dump;
339 There is also B<parser_type> and B<parser_args>, which perform
340 analogously to B<producer_type> and B<producer_args>
347 # parser as a mutator
351 # Passed a module name (string containing "::")
352 if ($parser =~ /::/) {
355 # Module name was passed directly
356 # We try to load the name; if it doesn't load, there's
357 # a possibility that it has a function name attached to
360 $func_name = "parse";
363 # Module::function was passed
365 # Passed Module::Name::function; try to recover
366 my @func_parts = split /::/, $parser;
367 $func_name = pop @func_parts;
368 $parser = join "::", @func_parts;
370 # If this doesn't work, then we have a legitimate
372 load($parser) or die "Can't load $parser: $@";
375 # get code reference and assign
376 $self->{'parser'} = \&{ "$parser\::$func_name" };
377 $self->{'parser_type'} = $parser;
378 $self->debug("Got parser: $parser\::$func_name");
381 # passed an anonymous subroutine reference
382 elsif (isa($parser, 'CODE')) {
383 $self->{'parser'} = $parser;
384 $self->{'parser_type'} = "CODE";
385 $self->debug("Got parser: code ref");
388 # passed a string containing no "::"; relative package name
390 my $Pp = sprintf "SQL::Translator::Parser::$parser";
391 load($Pp) or die "Can't load $Pp: $@";
392 $self->{'parser'} = \&{ "$Pp\::parse" };
393 $self->{'parser_type'} = $Pp;
394 $self->debug("Got parser: $Pp");
397 # At this point, $self->{'parser'} contains a subroutine
398 # reference that is ready to run
400 $self->parser_args(@_) if (@_);
403 return $self->{'parser'};
406 sub parser_type { $_[0]->{'parser_type'} }
412 my $args = isa($_[0], 'HASH') ? shift : { @_ };
413 $self->{'parser_args'} = $args;
415 $self->{'parser_args'};
420 The B<translate> method calls the subroutines referenced by the
421 B<parser> and B<producer> data members (described above). It accepts
422 as arguments a number of things, in key => value format, including
423 (potentially) a parser and a producer (they are passed directly to the
424 B<parser> and B<producer> methods).
426 Here is how the parameter list to B<translate> is parsed:
432 1 argument means it's the data to be parsed; which could be a string
433 (filename) or a refernce to a scalar (a string stored in memory), or a
434 reference to a hash, which is parsed as being more than one argument
437 # Parse the file /path/to/datafile
438 my $output = $tr->translate("/path/to/datafile");
440 # Parse the data contained in the string $data
441 my $output = $tr->translate(\$data);
445 More than 1 argument means its a hash of things, and it might be
446 setting a parser, producer, or datasource (this key is named
447 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
449 # As above, parse /path/to/datafile, but with different producers
450 for my $prod ("MySQL", "XML", "Sybase") {
451 print $tr->translate(
453 filename => "/path/to/datafile",
457 # The filename hash key could also be:
458 datasource => \$data,
464 =head2 B<filename>, B<data>
466 Using the B<filename> method, the filename of the data to be parsed
467 can be set. This method can be used in conjunction with the B<data>
468 method, below. If both the B<filename> and B<data> methods are
469 invoked as mutators, the data set in the B<data> method is used.
471 $tr->filename("/my/data/files/create.sql");
475 my $create_script = do {
477 open CREATE, "/my/data/files/create.sql" or die $!;
480 $tr->data(\$create_script);
482 B<filename> takes a string, which is interpreted as a filename.
483 B<data> takes a reference to a string, which is used as the data to be
484 parsed. If a filename is set, then that file is opened and read when
485 the B<translate> method is called, as long as the data instance
490 # filename - get or set the filename
494 my $filename = shift;
496 my $msg = "Cannot use directory '$filename' as input source";
497 $self->error_out($msg);
499 } elsif (-f _ && -r _) {
500 $self->{'filename'} = $filename;
501 $self->debug("Got filename: $self->{'filename'}");
503 my $msg = "Cannot use '$filename' as input source: ".
504 "file does not exist or is not readable.";
505 $self->error_out($msg);
513 # data - get or set the data
514 # if $self->{'data'} is not set, but $self->{'filename'} is, then
515 # $self->{'filename'} is opened and read, whith the results put into
520 # Set $self->{'data'} to $_[0], if it is provided.
523 if (isa($data, "SCALAR")) {
524 $self->{'data'} = $data;
526 elsif (! ref $data) {
527 $self->{'data'} = \$data;
531 # If we have a filename but no data yet, populate.
532 if (not $self->{'data'} and my $filename = $self->filename) {
533 $self->debug("Opening '$filename' to get contents...");
538 unless (open FH, $filename) {
539 $self->error_out("Can't open $filename for reading: $!");
544 $self->{'data'} = \$data;
547 $self->error_out("Can't close $filename: $!");
552 return $self->{'data'};
558 my ($args, $parser, $parser_type, $producer, $producer_type);
559 my ($parser_output, $producer_output);
563 # Passed a reference to a hash?
564 if (isa($_[0], 'HASH')) {
566 $self->debug("translate: Got a hashref");
570 # Passed a reference to a string containing the data
571 elsif (isa($_[0], 'SCALAR')) {
572 # passed a ref to a string
573 $self->debug("translate: Got a SCALAR reference (string)");
577 # Not a reference; treat it as a filename
578 elsif (! ref $_[0]) {
579 # Not a ref, it's a filename
580 $self->debug("translate: Got a filename");
581 $self->filename($_[0]);
584 # Passed something else entirely.
586 # We're not impressed. Take your empty string and leave.
589 # Actually, if data, parser, and producer are set, then we
590 # can continue. Too bad, because I like my comment
592 return "" unless ($self->data &&
598 # You must pass in a hash, or you get nothing.
603 # ----------------------------------------------------------------------
604 # Can specify the data to be transformed using "filename", "file",
605 # "data", or "datasource".
606 # ----------------------------------------------------------------------
607 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
608 $self->filename($filename);
611 if (my $data = ($self->{'data'} || $self->{'datasource'})) {
615 # ----------------------------------------------------------------
617 # ----------------------------------------------------------------
618 my $data = $self->data;
619 unless (length $$data) {
620 $self->error_out("Empty data file!");
624 # ----------------------------------------------------------------
625 # Local reference to the parser subroutine
626 # ----------------------------------------------------------------
627 if ($parser = ($args->{'parser'} || $args->{'from'})) {
628 $self->parser($parser);
630 $parser = $self->parser;
631 $parser_type = $self->parser_type;
633 # ----------------------------------------------------------------
634 # Local reference to the producer subroutine
635 # ----------------------------------------------------------------
636 if ($producer = ($args->{'producer'} || $args->{'to'})) {
637 $self->producer($producer);
639 $producer = $self->producer;
640 $producer_type = $self->producer_type;
642 # ----------------------------------------------------------------
643 # Execute the parser, then execute the producer with that output.
644 # Allowances are made for each piece to die, or fail to compile,
645 # since the referenced subroutines could be almost anything. In
646 # the future, each of these might happen in a Safe environment,
647 # depending on how paranoid we want to be.
648 # ----------------------------------------------------------------
649 eval { $parser_output = $parser->($self, $$data) };
650 if ($@ || ! $parser_output) {
651 my $msg = sprintf "translate: Error with parser '%s': %s",
652 $parser_type, ($@) ? $@ : " no results";
653 $self->error_out($msg);
657 eval { $producer_output = $producer->($self, $parser_output) };
658 if ($@ || ! $producer_output) {
659 my $msg = sprintf "translate: Error with producer '%s': %s",
660 $producer_type, ($@) ? $@ : " no results";
661 $self->error_out($msg);
665 return $producer_output;
670 The error method returns the last error.
674 #-----------------------------------------------------
677 # Return the last error.
679 return shift()->{'error'} || '';
684 Record the error and return undef. The error can be retrieved by
685 calling programs using $tr->error.
687 For Parser or Producer writers, primarily.
694 if ( my $error = shift ) {
695 $self->{'error'} = $error;
702 If the global variable $SQL::Translator::DEBUG is set to a true value,
703 then calls to $tr->debug($msg) will be carped to STDERR. If $DEBUG is
704 not set, then this method does nothing.
712 # carp @_ if $self->{'debug'};
716 my $class = ref $self || $self;
717 carp "[$class] $_" for @_;
723 my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
724 return 1 if $INC{$module};
726 eval { require $module };
735 #-----------------------------------------------------
736 # Rescue the drowning and tie your shoestrings.
737 # Henry David Thoreau
738 #-----------------------------------------------------
742 Ken Y. Clark, E<lt>kclark@logsoft.comE<gt>,
743 darren chamberlain E<lt>darren@cpan.orgE<gt>
747 This program is free software; you can redistribute it and/or modify
748 it under the terms of the GNU General Public License as published by
749 the Free Software Foundation; version 2.
751 This program is distributed in the hope that it will be useful, but
752 WITHOUT ANY WARRANTY; without even the implied warranty of
753 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
754 General Public License for more details.
756 You should have received a copy of the GNU General Public License
757 along with this program; if not, write to the Free Software
758 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
763 L<perl>, L<Parse::RecDescent>