Some minor mods to POD.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator.pm
CommitLineData
16dc9970 1package SQL::Translator;
2
b346d8f1 3# ----------------------------------------------------------------------
87bf8a3a 4# $Id: Translator.pm,v 1.18 2003-03-04 21:20:17 kycl4rk Exp $
b346d8f1 5# ----------------------------------------------------------------------
abfa405a 6# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7# darren chamberlain <darren@cpan.org>,
8# Chris Mungall <cjm@fruitfly.org>
1fd8c91f 9#
077ebf34 10# This program is free software; you can redistribute it and/or
11# modify it under the terms of the GNU General Public License as
12# published by the Free Software Foundation; version 2.
ca10f295 13#
077ebf34 14# This program is distributed in the hope that it will be useful, but
15# WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17# General Public License for more details.
ca10f295 18#
077ebf34 19# You should have received a copy of the GNU General Public License
20# along with this program; if not, write to the Free Software
21# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
22# 02111-1307 USA
ca10f295 23# -------------------------------------------------------------------
24
16dc9970 25use strict;
d529894e 26use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR );
49e1eb70 27use base 'Class::Base';
c2d3a526 28
d529894e 29$VERSION = '0.01';
87bf8a3a 30$REVISION = sprintf "%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/;
d529894e 31$DEBUG = 0 unless defined $DEBUG;
32$ERROR = "";
c2d3a526 33
34use Carp qw(carp);
16dc9970 35
c0c4aef9 36use File::Spec::Functions qw(catfile);
37use File::Basename qw(dirname);
38use IO::Dir;
39
b346d8f1 40# ----------------------------------------------------------------------
41# The default behavior is to "pass through" values (note that the
42# SQL::Translator instance is the first value ($_[0]), and the stuff
43# to be parsed is the second value ($_[1])
44# ----------------------------------------------------------------------
45$DEFAULT_SUB = sub { $_[1] } unless defined $DEFAULT_SUB;
16dc9970 46
b346d8f1 47# ----------------------------------------------------------------------
c2d3a526 48# init([ARGS])
b346d8f1 49# The constructor.
dfb4c915 50#
b346d8f1 51# new takes an optional hash of arguments. These arguments may
52# include a parser, specified with the keys "parser" or "from",
53# and a producer, specified with the keys "producer" or "to".
dfb4c915 54#
b346d8f1 55# The values that can be passed as the parser or producer are
56# given directly to the parser or producer methods, respectively.
57# See the appropriate method description below for details about
58# what each expects/accepts.
b346d8f1 59# ----------------------------------------------------------------------
c2d3a526 60sub init {
49e1eb70 61 my ( $self, $config ) = @_;
1fd8c91f 62
49e1eb70 63 #
b346d8f1 64 # Set the parser and producer.
ca10f295 65 #
b346d8f1 66 # If a 'parser' or 'from' parameter is passed in, use that as the
67 # parser; if a 'producer' or 'to' parameter is passed in, use that
68 # as the producer; both default to $DEFAULT_SUB.
49e1eb70 69 #
70 $self->parser ($config->{'parser'} || $config->{'from'} || $DEFAULT_SUB);
c2d3a526 71 $self->producer($config->{'producer'} || $config->{'to'} || $DEFAULT_SUB);
ca10f295 72
49e1eb70 73 #
e2158c40 74 # Set the parser_args and producer_args
49e1eb70 75 #
76 for my $pargs ( qw[ parser_args producer_args ] ) {
77 $self->$pargs( $config->{$pargs} ) if defined $config->{ $pargs };
e2158c40 78 }
79
49e1eb70 80 #
9398955f 81 # Set the data source, if 'filename' or 'file' is provided.
49e1eb70 82 #
c2d3a526 83 $config->{'filename'} ||= $config->{'file'} || "";
49e1eb70 84 $self->filename( $config->{'filename'} ) if $config->{'filename'};
9398955f 85
49e1eb70 86 #
87 # Finally, if there is a 'data' parameter, use that in
88 # preference to filename and file
89 #
90 if ( my $data = $config->{'data'} ) {
91 $self->data( $data );
9398955f 92 }
93
d529894e 94 #
95 # Set various other options.
96 #
49e1eb70 97 $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
ca10f295 98
96844cae 99
100 $self->add_drop_table( $config->{'add_drop_table'} );
d529894e 101
102 $self->custom_translate( $config->{'xlate'} );
103
104 $self->no_comments( $config->{'no_comments'} );
105
96844cae 106 $self->show_warnings( $config->{'show_warnings'} );
107
108 $self->trace( $config->{'trace'} );
109
ca10f295 110 return $self;
dfb4c915 111}
1fd8c91f 112
0f3778d0 113# ----------------------------------------------------------------------
114# add_drop_table([$bool])
115# ----------------------------------------------------------------------
96844cae 116sub add_drop_table {
117 my $self = shift;
118 if ( defined (my $arg = shift) ) {
119 $self->{'add_drop_table'} = $arg ? 1 : 0;
120 }
121 return $self->{'add_drop_table'} || 0;
122}
123
124
0f3778d0 125# ----------------------------------------------------------------------
126# custom_translate([$bool])
127# ----------------------------------------------------------------------
d529894e 128sub custom_translate {
129 my $self = shift;
130 $self->{'custom_translate'} = shift if @_;
131 return $self->{'custom_translate'} || {};
132}
133
0f3778d0 134# ----------------------------------------------------------------------
135# no_comments([$bool])
136# ----------------------------------------------------------------------
d529894e 137sub no_comments {
138 my $self = shift;
139 my $arg = shift;
140 if ( defined $arg ) {
141 $self->{'no_comments'} = $arg ? 1 : 0;
142 }
143 return $self->{'no_comments'} || 0;
144}
145
e2158c40 146
0f3778d0 147# ----------------------------------------------------------------------
148# producer([$producer_spec])
149#
150# Get or set the producer for the current translator.
151# ----------------------------------------------------------------------
ca10f295 152sub producer {
1fd8c91f 153 my $self = shift;
b346d8f1 154
7a8e1f51 155 # producer as a mutator
ca10f295 156 if (@_) {
157 my $producer = shift;
b346d8f1 158
7a8e1f51 159 # Passed a module name (string containing "::")
ca10f295 160 if ($producer =~ /::/) {
077ebf34 161 my $func_name;
b346d8f1 162
7a8e1f51 163 # Module name was passed directly
b346d8f1 164 # We try to load the name; if it doesn't load, there's
165 # a possibility that it has a function name attached to
166 # it.
077ebf34 167 if (load($producer)) {
168 $func_name = "produce";
7a8e1f51 169 }
b346d8f1 170
7a8e1f51 171 # Module::function was passed
b346d8f1 172 else {
173 # Passed Module::Name::function; try to recover
077ebf34 174 my @func_parts = split /::/, $producer;
175 $func_name = pop @func_parts;
176 $producer = join "::", @func_parts;
b346d8f1 177
178 # If this doesn't work, then we have a legitimate
179 # problem.
077ebf34 180 load($producer) or die "Can't load $producer: $@";
7a8e1f51 181 }
077ebf34 182
7a8e1f51 183 # get code reference and assign
077ebf34 184 $self->{'producer'} = \&{ "$producer\::$func_name" };
185 $self->{'producer_type'} = $producer;
49e1eb70 186 $self->debug("Got producer: $producer\::$func_name\n");
7a8e1f51 187 }
b346d8f1 188
7a8e1f51 189 # passed an anonymous subroutine reference
b346d8f1 190 elsif (isa($producer, 'CODE')) {
ca10f295 191 $self->{'producer'} = $producer;
077ebf34 192 $self->{'producer_type'} = "CODE";
49e1eb70 193 $self->debug("Got producer: code ref\n");
7a8e1f51 194 }
b346d8f1 195
7a8e1f51 196 # passed a string containing no "::"; relative package name
b346d8f1 197 else {
ca10f295 198 my $Pp = sprintf "SQL::Translator::Producer::$producer";
199 load($Pp) or die "Can't load $Pp: $@";
077ebf34 200 $self->{'producer'} = \&{ "$Pp\::produce" };
201 $self->{'producer_type'} = $Pp;
49e1eb70 202 $self->debug("Got producer: $Pp\n");
7a8e1f51 203 }
b346d8f1 204
ca10f295 205 # At this point, $self->{'producer'} contains a subroutine
b346d8f1 206 # reference that is ready to run
e2158c40 207
7a8e1f51 208 # Anything left? If so, it's producer_args
209 $self->producer_args(@_) if (@_);
210 }
b346d8f1 211
ca10f295 212 return $self->{'producer'};
213};
077ebf34 214
7a8e1f51 215# ----------------------------------------------------------------------
0f3778d0 216# producer_type()
7a8e1f51 217#
e2158c40 218# producer_type is an accessor that allows producer subs to get
219# information about their origin. This is poptentially important;
ca251f03 220# since all producer subs are called as subroutine references, there is
e2158c40 221# no way for a producer to find out which package the sub lives in
222# originally, for example.
7a8e1f51 223# ----------------------------------------------------------------------
224sub producer_type { $_[0]->{'producer_type'} }
e2158c40 225
7a8e1f51 226# ----------------------------------------------------------------------
0f3778d0 227# producer_args([\%args])
7a8e1f51 228#
e2158c40 229# Arbitrary name => value pairs of paramters can be passed to a
230# producer using this method.
52b828e8 231#
0f3778d0 232# If the first argument passed in is undef, then the hash of arguments
233# is cleared; all subsequent elements are added to the hash of name,
234# value pairs stored as producer_args.
7a8e1f51 235# ----------------------------------------------------------------------
e2158c40 236sub producer_args {
237 my $self = shift;
0f3778d0 238 return $self->_args("producer", @_);
7a8e1f51 239}
ca10f295 240
0f3778d0 241# ----------------------------------------------------------------------
242# parser([$parser_spec])
243# ----------------------------------------------------------------------
ca10f295 244sub parser {
245 my $self = shift;
b346d8f1 246
7a8e1f51 247 # parser as a mutator
ca10f295 248 if (@_) {
249 my $parser = shift;
b346d8f1 250
7a8e1f51 251 # Passed a module name (string containing "::")
ca10f295 252 if ($parser =~ /::/) {
b346d8f1 253 my $func_name;
254
7a8e1f51 255 # Module name was passed directly
b346d8f1 256 # We try to load the name; if it doesn't load, there's
257 # a possibility that it has a function name attached to
258 # it.
259 if (load($parser)) {
260 $func_name = "parse";
7a8e1f51 261 }
b346d8f1 262
7a8e1f51 263 # Module::function was passed
b346d8f1 264 else {
265 # Passed Module::Name::function; try to recover
266 my @func_parts = split /::/, $parser;
267 $func_name = pop @func_parts;
268 $parser = join "::", @func_parts;
269
270 # If this doesn't work, then we have a legitimate
271 # problem.
272 load($parser) or die "Can't load $parser: $@";
7a8e1f51 273 }
b346d8f1 274
7a8e1f51 275 # get code reference and assign
b346d8f1 276 $self->{'parser'} = \&{ "$parser\::$func_name" };
077ebf34 277 $self->{'parser_type'} = $parser;
49e1eb70 278 $self->debug("Got parser: $parser\::$func_name\n");
7a8e1f51 279 }
b346d8f1 280
7a8e1f51 281 # passed an anonymous subroutine reference
49e1eb70 282 elsif ( isa( $parser, 'CODE' ) ) {
283 $self->{'parser'} = $parser;
077ebf34 284 $self->{'parser_type'} = "CODE";
49e1eb70 285 $self->debug("Got parser: code ref\n");
7a8e1f51 286 }
b346d8f1 287
7a8e1f51 288 # passed a string containing no "::"; relative package name
b346d8f1 289 else {
49e1eb70 290 my $Pp = "SQL::Translator::Parser::$parser";
291 load( $Pp ) or die "Can't load $Pp: $@";
292 $self->{'parser'} = \&{ "$Pp\::parse" };
077ebf34 293 $self->{'parser_type'} = $Pp;
49e1eb70 294 $self->debug("Got parser: $Pp\n");
7a8e1f51 295 }
b346d8f1 296
49e1eb70 297 #
b346d8f1 298 # At this point, $self->{'parser'} contains a subroutine
299 # reference that is ready to run
49e1eb70 300 #
301 $self->parser_args( @_ ) if (@_);
7a8e1f51 302 }
b346d8f1 303
ca10f295 304 return $self->{'parser'};
16dc9970 305}
1fd8c91f 306
d529894e 307# ----------------------------------------------------------------------
077ebf34 308sub parser_type { $_[0]->{'parser_type'} }
e2158c40 309
e2158c40 310sub parser_args {
311 my $self = shift;
0f3778d0 312 return $self->_args("parser", @_);
313}
96844cae 314
315sub show_warnings {
316 my $self = shift;
317 my $arg = shift;
318 if ( defined $arg ) {
319 $self->{'show_warnings'} = $arg ? 1 : 0;
320 }
321 return $self->{'show_warnings'} || 0;
322}
323
ca10f295 324
0f3778d0 325# filename - get or set the filename
326sub filename {
327 my $self = shift;
328 if (@_) {
329 my $filename = shift;
330 if (-d $filename) {
331 my $msg = "Cannot use directory '$filename' as input source";
332 return $self->error($msg);
333 } elsif (-f _ && -r _) {
334 $self->{'filename'} = $filename;
335 $self->debug("Got filename: '$self->{'filename'}'\n");
336 } else {
337 my $msg = "Cannot use '$filename' as input source: ".
338 "file does not exist or is not readable.";
339 return $self->error($msg);
340 }
341 }
ca10f295 342
0f3778d0 343 $self->{'filename'};
344}
ca10f295 345
0f3778d0 346# ----------------------------------------------------------------------
347# data([$data])
348#
349# if $self->{'data'} is not set, but $self->{'filename'} is, then
350# $self->{'filename'} is opened and read, with the results put into
351# $self->{'data'}.
352# ----------------------------------------------------------------------
353sub data {
354 my $self = shift;
ca10f295 355
0f3778d0 356 # Set $self->{'data'} based on what was passed in. We will
357 # accept a number of things; do our best to get it right.
358 if (@_) {
359 my $data = shift;
360 if (isa($data, "SCALAR")) {
361 $self->{'data'} = $data;
362 }
363 else {
364 if (isa($data, 'ARRAY')) {
365 $data = join '', @$data;
366 }
367 elsif (isa($data, 'GLOB')) {
368 local $/;
369 $data = <$data>;
370 }
371 elsif (! ref $data && @_) {
372 $data = join '', $data, @_;
373 }
374 $self->{'data'} = \$data;
375 }
376 }
9398955f 377
7a8e1f51 378 # If we have a filename but no data yet, populate.
9398955f 379 if (not $self->{'data'} and my $filename = $self->filename) {
49e1eb70 380 $self->debug("Opening '$filename' to get contents.\n");
9398955f 381 local *FH;
382 local $/;
383 my $data;
384
385 unless (open FH, $filename) {
49e1eb70 386 return $self->error("Can't read file '$filename': $!");
9398955f 387 }
388
389 $data = <FH>;
390 $self->{'data'} = \$data;
391
392 unless (close FH) {
49e1eb70 393 return $self->error("Can't close file '$filename': $!");
9398955f 394 }
395 }
9398955f 396
397 return $self->{'data'};
7a8e1f51 398}
9398955f 399
d529894e 400
401sub trace {
402 my $self = shift;
403 my $arg = shift;
404 if ( defined $arg ) {
405 $self->{'trace'} = $arg ? 1 : 0;
406 }
407 return $self->{'trace'} || 0;
408}
409
410# ----------------------------------------------------------------------
0f3778d0 411# translate([source], [\%args])
412#
413# translate does the actual translation. The main argument is the
414# source of the data to be translated, which can be a filename, scalar
415# reference, or glob reference.
416#
417# Alternatively, translate takes optional arguements, which are passed
418# to the appropriate places. Most notable of these arguments are
419# parser and producer, which can be used to set the parser and
420# producer, respectively. This is the applications last chance to set
421# these.
422#
423# translate returns a string.
424# ----------------------------------------------------------------------
ca251f03 425sub translate {
426 my $self = shift;
427 my ($args, $parser, $parser_type, $producer, $producer_type);
428 my ($parser_output, $producer_output);
ca10f295 429
7a8e1f51 430 # Parse arguments
9398955f 431 if (@_ == 1) {
7a8e1f51 432 # Passed a reference to a hash?
ca10f295 433 if (isa($_[0], 'HASH')) {
7a8e1f51 434 # yep, a hashref
49e1eb70 435 $self->debug("translate: Got a hashref\n");
ca10f295 436 $args = $_[0];
437 }
9398955f 438
0f3778d0 439 # Passed a GLOB reference, i.e., filehandle
440 elsif (isa($_[0], 'GLOB')) {
441 $self->debug("translate: Got a GLOB reference\n");
442 $self->data($_[0]);
443 }
444
7a8e1f51 445 # Passed a reference to a string containing the data
ca10f295 446 elsif (isa($_[0], 'SCALAR')) {
9398955f 447 # passed a ref to a string
49e1eb70 448 $self->debug("translate: Got a SCALAR reference (string)\n");
9398955f 449 $self->data($_[0]);
ca10f295 450 }
9398955f 451
7a8e1f51 452 # Not a reference; treat it as a filename
b346d8f1 453 elsif (! ref $_[0]) {
ca10f295 454 # Not a ref, it's a filename
49e1eb70 455 $self->debug("translate: Got a filename\n");
9398955f 456 $self->filename($_[0]);
ca10f295 457 }
9398955f 458
7a8e1f51 459 # Passed something else entirely.
b346d8f1 460 else {
461 # We're not impressed. Take your empty string and leave.
38254289 462 # return "";
463
7a8e1f51 464 # Actually, if data, parser, and producer are set, then we
465 # can continue. Too bad, because I like my comment
466 # (above)...
38254289 467 return "" unless ($self->data &&
468 $self->producer &&
469 $self->parser);
b346d8f1 470 }
16dc9970 471 }
472 else {
b346d8f1 473 # You must pass in a hash, or you get nothing.
474 return "" if @_ % 2;
ca10f295 475 $args = { @_ };
7a8e1f51 476 }
16dc9970 477
9398955f 478 # ----------------------------------------------------------------------
479 # Can specify the data to be transformed using "filename", "file",
7a8e1f51 480 # "data", or "datasource".
9398955f 481 # ----------------------------------------------------------------------
7a8e1f51 482 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
9398955f 483 $self->filename($filename);
484 }
ca10f295 485
7a8e1f51 486 if (my $data = ($self->{'data'} || $self->{'datasource'})) {
9398955f 487 $self->data($data);
16dc9970 488 }
ca10f295 489
9398955f 490 # ----------------------------------------------------------------
491 # Get the data.
492 # ----------------------------------------------------------------
493 my $data = $self->data;
7a8e1f51 494 unless (length $$data) {
c2d3a526 495 return $self->error("Empty data file!");
9398955f 496 }
077ebf34 497
9398955f 498 # ----------------------------------------------------------------
ca10f295 499 # Local reference to the parser subroutine
9398955f 500 # ----------------------------------------------------------------
ca10f295 501 if ($parser = ($args->{'parser'} || $args->{'from'})) {
502 $self->parser($parser);
16dc9970 503 }
7a8e1f51 504 $parser = $self->parser;
505 $parser_type = $self->parser_type;
16dc9970 506
9398955f 507 # ----------------------------------------------------------------
ca10f295 508 # Local reference to the producer subroutine
9398955f 509 # ----------------------------------------------------------------
ca10f295 510 if ($producer = ($args->{'producer'} || $args->{'to'})) {
511 $self->producer($producer);
16dc9970 512 }
7a8e1f51 513 $producer = $self->producer;
514 $producer_type = $self->producer_type;
16dc9970 515
9398955f 516 # ----------------------------------------------------------------
7a8e1f51 517 # Execute the parser, then execute the producer with that output.
518 # Allowances are made for each piece to die, or fail to compile,
519 # since the referenced subroutines could be almost anything. In
520 # the future, each of these might happen in a Safe environment,
521 # depending on how paranoid we want to be.
9398955f 522 # ----------------------------------------------------------------
7a8e1f51 523 eval { $parser_output = $parser->($self, $$data) };
524 if ($@ || ! $parser_output) {
525 my $msg = sprintf "translate: Error with parser '%s': %s",
526 $parser_type, ($@) ? $@ : " no results";
c2d3a526 527 return $self->error($msg);
7a8e1f51 528 }
529
530 eval { $producer_output = $producer->($self, $parser_output) };
531 if ($@ || ! $producer_output) {
532 my $msg = sprintf "translate: Error with producer '%s': %s",
533 $producer_type, ($@) ? $@ : " no results";
c2d3a526 534 return $self->error($msg);
7a8e1f51 535 }
536
537 return $producer_output;
16dc9970 538}
ca10f295 539
d529894e 540# ----------------------------------------------------------------------
0f3778d0 541# list_parsers()
542#
543# Hacky sort of method to list all available parsers. This has
544# several problems:
545#
546# - Only finds things in the SQL::Translator::Parser namespace
547#
548# - Only finds things that are located in the same directory
549# as SQL::Translator::Parser. Yeck.
550#
551# This method will fail in several very likely cases:
552#
553# - Parser modules in different namespaces
554#
555# - Parser modules in the SQL::Translator::Parser namespace that
556# have any XS componenets will be installed in
557# arch_lib/SQL/Translator.
558#
559# ----------------------------------------------------------------------
560sub list_parsers {
561 return _list("parsers");
562}
563
564# ----------------------------------------------------------------------
565# list_producers()
566#
567# See notes for list_parsers(), above; all the problems apply to
568# list_producers as well.
569# ----------------------------------------------------------------------
c0c4aef9 570sub list_producers {
0f3778d0 571 return _list("producers");
572}
573
c0c4aef9 574
0f3778d0 575# ======================================================================
576# Private Methods
577# ======================================================================
c0c4aef9 578
0f3778d0 579# ----------------------------------------------------------------------
580# _args($type, \%args);
581#
582# Gets or sets ${type}_args. Called by parser_args and producer_args.
583# ----------------------------------------------------------------------
584sub _args {
585 my $self = shift;
586 my $type = shift;
587 $type = "${type}_args" unless $type =~ /_args$/;
588
589 unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
590 $self->{$type} = { };
591 }
592
593 if (@_) {
594 # If the first argument is an explicit undef (remember, we
595 # don't get here unless there is stuff in @_), then we clear
596 # out the producer_args hash.
597 if (! defined $_[0]) {
598 shift @_;
599 %{$self->{$type}} = ();
600 }
601
602 my $args = isa($_[0], 'HASH') ? shift : { @_ };
603 %{$self->{$type}} = (%{$self->{$type}}, %$args);
604 }
605
606 $self->{$type};
c0c4aef9 607}
608
0f3778d0 609
d529894e 610# ----------------------------------------------------------------------
0f3778d0 611# _list($type)
612# ----------------------------------------------------------------------
613sub _list {
614 my $type = ucfirst lc $_[0] || return ();
c0c4aef9 615
0f3778d0 616 load("SQL::Translator::$type");
617 my $path = catfile(dirname($INC{'SQL/Translator/$type.pm'}), $type);
618 my $dh = IO::Dir->new($path);
c0c4aef9 619
0f3778d0 620 return map { join "::", "SQL::Translator::$type", $_ }
621 grep /\.pm$/, $dh->read;
c0c4aef9 622}
623
d529894e 624# ----------------------------------------------------------------------
0f3778d0 625# load($module)
626#
627# Loads a Perl module. Short circuits if a module is already loaded.
628# ----------------------------------------------------------------------
ca10f295 629sub load {
630 my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
631 return 1 if $INC{$module};
632
633 eval { require $module };
634
635 return if ($@);
636 return 1;
1fd8c91f 637}
16dc9970 638
d529894e 639# ----------------------------------------------------------------------
0f3778d0 640# isa($ref, $type)
641#
642# Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
643# but I like function overhead.
644# ----------------------------------------------------------------------
645sub isa($$) {
646 my ($ref, $type) = @_;
647 return UNIVERSAL::isa($ref, $type);
648}
c2d3a526 649
16dc9970 6501;
16dc9970 651#-----------------------------------------------------
652# Rescue the drowning and tie your shoestrings.
653# Henry David Thoreau
654#-----------------------------------------------------
655
0f3778d0 656__END__
657
658=head1 NAME
659
660SQL::Translator - convert schema from one database to another
661
662=head1 SYNOPSIS
663
664 use SQL::Translator;
665
666 my $translator = SQL::Translator->new(
87bf8a3a 667 debug => 1, # Print debug info
668 trace => 0, # Print Parse::RecDescent trace
669 no_comments => 0, # Don't include comments in output
670 show_warnings => 0, # Print name mutations, conflicts
671 add_drop_table => 1, # Add "drop table" statements
0f3778d0 672 );
673
674 my $output = $translator->translate(
675 from => "MySQL",
676 to => "Oracle",
677 filename => $file,
678 ) or die $translator->error;
679
680 print $output;
681
682=head1 DESCRIPTION
683
684This module attempts to simplify the task of converting one database
685create syntax to another through the use of Parsers (which understand
686the source format) and Producers (which understand the destination
687format). The idea is that any Parser can be used with any Producer in
688the conversion process. So, if you wanted Postgres-to-Oracle, you
689would use the Postgres parser and the Oracle producer.
690
691=head1 CONSTRUCTOR
692
693The constructor is called B<new>, and accepts a optional hash of options.
694Valid options are:
695
696=over 4
697
ca251f03 698=item *
699
700parser / from
701
702=item *
703
704parser_args
0f3778d0 705
ca251f03 706=item *
0f3778d0 707
ca251f03 708producer / to
0f3778d0 709
ca251f03 710=item *
0f3778d0 711
ca251f03 712producer_args
0f3778d0 713
ca251f03 714=item *
715
716filename / file
717
718=item *
719
720data
721
722=item *
0f3778d0 723
ca251f03 724debug
0f3778d0 725
726=back
727
728All options are, well, optional; these attributes can be set via
729instance methods. Internally, they are; no (non-syntactical)
730advantage is gained by passing options to the constructor.
731
732=head1 METHODS
733
734=head2 B<add_drop_table>
735
736Toggles whether or not to add "DROP TABLE" statements just before the
737create definitions.
738
739=head2 B<custom_translate>
740
741Allows the user to override default translation of fields. For example,
742if a MySQL "text" field would normally be converted to a "long" for Oracle,
743the user could specify to change it to a "CLOB." Accepts a hashref where
744keys are the "from" value and values are the "to," returns the current
745value of the field.
746
747=head2 B<no_comments>
748
749Toggles whether to print comments in the output. Accepts a true or false
750value, returns the current value.
751
752=head2 B<producer>
753
754The B<producer> method is an accessor/mutator, used to retrieve or
755define what subroutine is called to produce the output. A subroutine
756defined as a producer will be invoked as a function (I<not a method>)
ca251f03 757and passed 2 parameters: its container C<SQL::Translator> instance and a
0f3778d0 758data structure. It is expected that the function transform the data
ca251f03 759structure to a string. The C<SQL::Transformer> instance is provided for
0f3778d0 760informational purposes; for example, the type of the parser can be
761retrieved using the B<parser_type> method, and the B<error> and
762B<debug> methods can be called when needed.
763
ca251f03 764When defining a producer, one of several things can be passed in: A
765module name (e.g., C<My::Groovy::Producer>, a module name relative to
766the C<SQL::Translator::Producer> namespace (e.g., MySQL), a module
767name and function combination (C<My::Groovy::Producer::transmogrify>),
0f3778d0 768or a reference to an anonymous subroutine. If a full module name is
769passed in (for the purposes of this method, a string containing "::"
770is considered to be a module name), it is treated as a package, and a
ca251f03 771function called "produce" will be invoked: C<$modulename::produce>.
772If $modulename cannot be loaded, the final portion is stripped off and
0f3778d0 773treated as a function. In other words, if there is no file named
ca251f03 774F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
775to load F<My/Groovy/Producer.pm> and use transmogrify as the name of
776the function, instead of the default "produce".
0f3778d0 777
778 my $tr = SQL::Translator->new;
779
780 # This will invoke My::Groovy::Producer::produce($tr, $data)
781 $tr->producer("My::Groovy::Producer");
782
783 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
784 $tr->producer("Sybase");
785
786 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
787 # assuming that My::Groovy::Producer::transmogrify is not a module
788 # on disk.
789 $tr->producer("My::Groovy::Producer::transmogrify");
790
791 # This will invoke the referenced subroutine directly, as
792 # $subref->($tr, $data);
793 $tr->producer(\&my_producer);
794
795There is also a method named B<producer_type>, which is a string
796containing the classname to which the above B<produce> function
797belongs. In the case of anonymous subroutines, this method returns
798the string "CODE".
799
800Finally, there is a method named B<producer_args>, which is both an
801accessor and a mutator. Arbitrary data may be stored in name => value
802pairs for the producer subroutine to access:
803
804 sub My::Random::producer {
805 my ($tr, $data) = @_;
806 my $pr_args = $tr->producer_args();
807
808 # $pr_args is a hashref.
809
810Extra data passed to the B<producer> method is passed to
811B<producer_args>:
812
813 $tr->producer("xSV", delimiter => ',\s*');
814
815 # In SQL::Translator::Producer::xSV:
816 my $args = $tr->producer_args;
817 my $delimiter = $args->{'delimiter'}; # value is ,\s*
818
819=head2 B<parser>
820
821The B<parser> method defines or retrieves a subroutine that will be
822called to perform the parsing. The basic idea is the same as that of
823B<producer> (see above), except the default subroutine name is
ca251f03 824"parse", and will be invoked as C<$module_name::parse($tr, $data)>.
0f3778d0 825Also, the parser subroutine will be passed a string containing the
826entirety of the data to be parsed.
827
828 # Invokes SQL::Translator::Parser::MySQL::parse()
829 $tr->parser("MySQL");
830
831 # Invokes My::Groovy::Parser::parse()
832 $tr->parser("My::Groovy::Parser");
833
834 # Invoke an anonymous subroutine directly
835 $tr->parser(sub {
836 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
837 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
838 return $dumper->Dump;
839 });
840
841There is also B<parser_type> and B<parser_args>, which perform
842analogously to B<producer_type> and B<producer_args>
843
844=head2 B<show_warnings>
845
846Toggles whether to print warnings of name conflicts, identifier
847mutations, etc. Probably only generated by producers to let the user
848know when something won't translate very smoothly (e.g., MySQL "enum"
849fields into Oracle). Accepts a true or false value, returns the
850current value.
851
852=head2 B<translate>
853
854The B<translate> method calls the subroutines referenced by the
855B<parser> and B<producer> data members (described above). It accepts
856as arguments a number of things, in key => value format, including
857(potentially) a parser and a producer (they are passed directly to the
858B<parser> and B<producer> methods).
859
860Here is how the parameter list to B<translate> is parsed:
861
862=over
863
864=item *
865
8661 argument means it's the data to be parsed; which could be a string
ca251f03 867(filename) or a reference to a scalar (a string stored in memory), or a
0f3778d0 868reference to a hash, which is parsed as being more than one argument
869(see next section).
870
871 # Parse the file /path/to/datafile
872 my $output = $tr->translate("/path/to/datafile");
873
874 # Parse the data contained in the string $data
875 my $output = $tr->translate(\$data);
876
877=item *
878
879More than 1 argument means its a hash of things, and it might be
880setting a parser, producer, or datasource (this key is named
881"filename" or "file" if it's a file, or "data" for a SCALAR reference.
882
883 # As above, parse /path/to/datafile, but with different producers
884 for my $prod ("MySQL", "XML", "Sybase") {
885 print $tr->translate(
886 producer => $prod,
887 filename => "/path/to/datafile",
888 );
889 }
890
891 # The filename hash key could also be:
892 datasource => \$data,
893
894You get the idea.
895
896=back
897
898=head2 B<filename>, B<data>
899
900Using the B<filename> method, the filename of the data to be parsed
901can be set. This method can be used in conjunction with the B<data>
902method, below. If both the B<filename> and B<data> methods are
903invoked as mutators, the data set in the B<data> method is used.
904
905 $tr->filename("/my/data/files/create.sql");
906
907or:
908
909 my $create_script = do {
910 local $/;
911 open CREATE, "/my/data/files/create.sql" or die $!;
912 <CREATE>;
913 };
914 $tr->data(\$create_script);
915
916B<filename> takes a string, which is interpreted as a filename.
917B<data> takes a reference to a string, which is used as the data to be
918parsed. If a filename is set, then that file is opened and read when
919the B<translate> method is called, as long as the data instance
920variable is not set.
921
922=pod
923
924=head2 B<trace>
925
926Turns on/off the tracing option of Parse::RecDescent.
927
49e1eb70 928=pod
929
7a8e1f51 930=head1 AUTHORS
16dc9970 931
ca251f03 932Ken Y. Clark, E<lt>kclark@cpan.orgE<gt>,
933darren chamberlain E<lt>darren@cpan.orgE<gt>,
934Chris Mungall E<lt>cjm@fruitfly.orgE<gt>,
935Allen Day E<lt>allenday@users.sourceforge.netE<gt>
dfb4c915 936
ca10f295 937=head1 COPYRIGHT
16dc9970 938
ca10f295 939This program is free software; you can redistribute it and/or modify
940it under the terms of the GNU General Public License as published by
941the Free Software Foundation; version 2.
dfb4c915 942
ca10f295 943This program is distributed in the hope that it will be useful, but
944WITHOUT ANY WARRANTY; without even the implied warranty of
945MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
946General Public License for more details.
16dc9970 947
ca10f295 948You should have received a copy of the GNU General Public License
949along with this program; if not, write to the Free Software
950Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
951USA
16dc9970 952
87bf8a3a 953=head1 BUGS
954
955Please use http://rt.cpan.org/ for reporting bugs.
956
16dc9970 957=head1 SEE ALSO
958
abfa405a 959L<perl>,
960L<SQL::Translator::Parser>,
961L<SQL::Translator::Producer>,
962L<Parse::RecDescent>
16dc9970 963