Fixes to help with Oracle data types, also fixes with table constraints.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator.pm
CommitLineData
16dc9970 1package SQL::Translator;
2
b346d8f1 3# ----------------------------------------------------------------------
422298aa 4# $Id: Translator.pm,v 1.20 2003-04-07 16:18:15 dlc 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';
422298aa 30$REVISION = sprintf "%d.%02d", q$Revision: 1.20 $ =~ /(\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
422298aa 486 if (my $data = ($args->{'data'} || $args->{'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 {
ca1f2237 561 return shift->_list("parser");
0f3778d0 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 {
ca1f2237 571 return shift->_list("producer");
0f3778d0 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 {
ca1f2237 614 my $self = shift;
615 my $type = shift || return ();
616 my $uctype = ucfirst lc $type;
617 my %found;
618
619 load("SQL::Translator::$uctype") or return ();
620 my $path = catfile "SQL", "Translator", $uctype;
621 for (@INC) {
622 my $dir = catfile $_, $path;
623 $self->debug("_list_${type}s searching $dir");
624 next unless -d $dir;
625
626 my $dh = IO::Dir->new($dir);
627 for (grep /\.pm$/, $dh->read) {
628 s/\.pm$//;
629 $found{ join "::", "SQL::Translator::$uctype", $_ } = 1;
630 }
631 }
c0c4aef9 632
ca1f2237 633 return keys %found;
c0c4aef9 634}
635
d529894e 636# ----------------------------------------------------------------------
0f3778d0 637# load($module)
638#
639# Loads a Perl module. Short circuits if a module is already loaded.
640# ----------------------------------------------------------------------
ca10f295 641sub load {
642 my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
643 return 1 if $INC{$module};
ca1f2237 644
ca10f295 645 eval { require $module };
ca1f2237 646
647 return __PACKAGE__->error($@) if ($@);
ca10f295 648 return 1;
1fd8c91f 649}
16dc9970 650
d529894e 651# ----------------------------------------------------------------------
0f3778d0 652# isa($ref, $type)
653#
654# Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
655# but I like function overhead.
656# ----------------------------------------------------------------------
657sub isa($$) {
658 my ($ref, $type) = @_;
659 return UNIVERSAL::isa($ref, $type);
660}
c2d3a526 661
16dc9970 6621;
16dc9970 663#-----------------------------------------------------
664# Rescue the drowning and tie your shoestrings.
665# Henry David Thoreau
666#-----------------------------------------------------
667
0f3778d0 668__END__
669
670=head1 NAME
671
672SQL::Translator - convert schema from one database to another
673
674=head1 SYNOPSIS
675
676 use SQL::Translator;
677
678 my $translator = SQL::Translator->new(
87bf8a3a 679 debug => 1, # Print debug info
680 trace => 0, # Print Parse::RecDescent trace
681 no_comments => 0, # Don't include comments in output
682 show_warnings => 0, # Print name mutations, conflicts
683 add_drop_table => 1, # Add "drop table" statements
0f3778d0 684 );
685
686 my $output = $translator->translate(
687 from => "MySQL",
688 to => "Oracle",
689 filename => $file,
690 ) or die $translator->error;
691
692 print $output;
693
694=head1 DESCRIPTION
695
696This module attempts to simplify the task of converting one database
697create syntax to another through the use of Parsers (which understand
698the source format) and Producers (which understand the destination
699format). The idea is that any Parser can be used with any Producer in
700the conversion process. So, if you wanted Postgres-to-Oracle, you
701would use the Postgres parser and the Oracle producer.
702
703=head1 CONSTRUCTOR
704
705The constructor is called B<new>, and accepts a optional hash of options.
706Valid options are:
707
708=over 4
709
ca251f03 710=item *
711
712parser / from
713
714=item *
715
716parser_args
0f3778d0 717
ca251f03 718=item *
0f3778d0 719
ca251f03 720producer / to
0f3778d0 721
ca251f03 722=item *
0f3778d0 723
ca251f03 724producer_args
0f3778d0 725
ca251f03 726=item *
727
728filename / file
729
730=item *
731
732data
733
734=item *
0f3778d0 735
ca251f03 736debug
0f3778d0 737
738=back
739
740All options are, well, optional; these attributes can be set via
741instance methods. Internally, they are; no (non-syntactical)
742advantage is gained by passing options to the constructor.
743
744=head1 METHODS
745
746=head2 B<add_drop_table>
747
748Toggles whether or not to add "DROP TABLE" statements just before the
749create definitions.
750
751=head2 B<custom_translate>
752
753Allows the user to override default translation of fields. For example,
754if a MySQL "text" field would normally be converted to a "long" for Oracle,
755the user could specify to change it to a "CLOB." Accepts a hashref where
756keys are the "from" value and values are the "to," returns the current
757value of the field.
758
759=head2 B<no_comments>
760
761Toggles whether to print comments in the output. Accepts a true or false
762value, returns the current value.
763
764=head2 B<producer>
765
766The B<producer> method is an accessor/mutator, used to retrieve or
767define what subroutine is called to produce the output. A subroutine
768defined as a producer will be invoked as a function (I<not a method>)
ca251f03 769and passed 2 parameters: its container C<SQL::Translator> instance and a
0f3778d0 770data structure. It is expected that the function transform the data
ca251f03 771structure to a string. The C<SQL::Transformer> instance is provided for
0f3778d0 772informational purposes; for example, the type of the parser can be
773retrieved using the B<parser_type> method, and the B<error> and
774B<debug> methods can be called when needed.
775
ca251f03 776When defining a producer, one of several things can be passed in: A
777module name (e.g., C<My::Groovy::Producer>, a module name relative to
778the C<SQL::Translator::Producer> namespace (e.g., MySQL), a module
779name and function combination (C<My::Groovy::Producer::transmogrify>),
0f3778d0 780or a reference to an anonymous subroutine. If a full module name is
781passed in (for the purposes of this method, a string containing "::"
782is considered to be a module name), it is treated as a package, and a
ca251f03 783function called "produce" will be invoked: C<$modulename::produce>.
784If $modulename cannot be loaded, the final portion is stripped off and
0f3778d0 785treated as a function. In other words, if there is no file named
ca251f03 786F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
787to load F<My/Groovy/Producer.pm> and use transmogrify as the name of
788the function, instead of the default "produce".
0f3778d0 789
790 my $tr = SQL::Translator->new;
791
792 # This will invoke My::Groovy::Producer::produce($tr, $data)
793 $tr->producer("My::Groovy::Producer");
794
795 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
796 $tr->producer("Sybase");
797
798 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
799 # assuming that My::Groovy::Producer::transmogrify is not a module
800 # on disk.
801 $tr->producer("My::Groovy::Producer::transmogrify");
802
803 # This will invoke the referenced subroutine directly, as
804 # $subref->($tr, $data);
805 $tr->producer(\&my_producer);
806
807There is also a method named B<producer_type>, which is a string
808containing the classname to which the above B<produce> function
809belongs. In the case of anonymous subroutines, this method returns
810the string "CODE".
811
812Finally, there is a method named B<producer_args>, which is both an
813accessor and a mutator. Arbitrary data may be stored in name => value
814pairs for the producer subroutine to access:
815
816 sub My::Random::producer {
817 my ($tr, $data) = @_;
818 my $pr_args = $tr->producer_args();
819
820 # $pr_args is a hashref.
821
822Extra data passed to the B<producer> method is passed to
823B<producer_args>:
824
825 $tr->producer("xSV", delimiter => ',\s*');
826
827 # In SQL::Translator::Producer::xSV:
828 my $args = $tr->producer_args;
829 my $delimiter = $args->{'delimiter'}; # value is ,\s*
830
831=head2 B<parser>
832
833The B<parser> method defines or retrieves a subroutine that will be
834called to perform the parsing. The basic idea is the same as that of
835B<producer> (see above), except the default subroutine name is
ca251f03 836"parse", and will be invoked as C<$module_name::parse($tr, $data)>.
0f3778d0 837Also, the parser subroutine will be passed a string containing the
838entirety of the data to be parsed.
839
840 # Invokes SQL::Translator::Parser::MySQL::parse()
841 $tr->parser("MySQL");
842
843 # Invokes My::Groovy::Parser::parse()
844 $tr->parser("My::Groovy::Parser");
845
846 # Invoke an anonymous subroutine directly
847 $tr->parser(sub {
848 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
849 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
850 return $dumper->Dump;
851 });
852
853There is also B<parser_type> and B<parser_args>, which perform
854analogously to B<producer_type> and B<producer_args>
855
856=head2 B<show_warnings>
857
858Toggles whether to print warnings of name conflicts, identifier
859mutations, etc. Probably only generated by producers to let the user
860know when something won't translate very smoothly (e.g., MySQL "enum"
861fields into Oracle). Accepts a true or false value, returns the
862current value.
863
864=head2 B<translate>
865
866The B<translate> method calls the subroutines referenced by the
867B<parser> and B<producer> data members (described above). It accepts
868as arguments a number of things, in key => value format, including
869(potentially) a parser and a producer (they are passed directly to the
870B<parser> and B<producer> methods).
871
872Here is how the parameter list to B<translate> is parsed:
873
874=over
875
876=item *
877
8781 argument means it's the data to be parsed; which could be a string
ca251f03 879(filename) or a reference to a scalar (a string stored in memory), or a
0f3778d0 880reference to a hash, which is parsed as being more than one argument
881(see next section).
882
883 # Parse the file /path/to/datafile
884 my $output = $tr->translate("/path/to/datafile");
885
886 # Parse the data contained in the string $data
887 my $output = $tr->translate(\$data);
888
889=item *
890
891More than 1 argument means its a hash of things, and it might be
892setting a parser, producer, or datasource (this key is named
893"filename" or "file" if it's a file, or "data" for a SCALAR reference.
894
895 # As above, parse /path/to/datafile, but with different producers
896 for my $prod ("MySQL", "XML", "Sybase") {
897 print $tr->translate(
898 producer => $prod,
899 filename => "/path/to/datafile",
900 );
901 }
902
903 # The filename hash key could also be:
904 datasource => \$data,
905
906You get the idea.
907
908=back
909
910=head2 B<filename>, B<data>
911
912Using the B<filename> method, the filename of the data to be parsed
913can be set. This method can be used in conjunction with the B<data>
914method, below. If both the B<filename> and B<data> methods are
915invoked as mutators, the data set in the B<data> method is used.
916
917 $tr->filename("/my/data/files/create.sql");
918
919or:
920
921 my $create_script = do {
922 local $/;
923 open CREATE, "/my/data/files/create.sql" or die $!;
924 <CREATE>;
925 };
926 $tr->data(\$create_script);
927
928B<filename> takes a string, which is interpreted as a filename.
929B<data> takes a reference to a string, which is used as the data to be
930parsed. If a filename is set, then that file is opened and read when
931the B<translate> method is called, as long as the data instance
932variable is not set.
933
934=pod
935
936=head2 B<trace>
937
938Turns on/off the tracing option of Parse::RecDescent.
939
49e1eb70 940=pod
941
7a8e1f51 942=head1 AUTHORS
16dc9970 943
ca251f03 944Ken Y. Clark, E<lt>kclark@cpan.orgE<gt>,
945darren chamberlain E<lt>darren@cpan.orgE<gt>,
946Chris Mungall E<lt>cjm@fruitfly.orgE<gt>,
947Allen Day E<lt>allenday@users.sourceforge.netE<gt>
dfb4c915 948
ca10f295 949=head1 COPYRIGHT
16dc9970 950
ca10f295 951This program is free software; you can redistribute it and/or modify
952it under the terms of the GNU General Public License as published by
953the Free Software Foundation; version 2.
dfb4c915 954
ca10f295 955This program is distributed in the hope that it will be useful, but
956WITHOUT ANY WARRANTY; without even the implied warranty of
957MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
958General Public License for more details.
16dc9970 959
ca10f295 960You should have received a copy of the GNU General Public License
961along with this program; if not, write to the Free Software
962Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
963USA
16dc9970 964
87bf8a3a 965=head1 BUGS
966
967Please use http://rt.cpan.org/ for reporting bugs.
968
16dc9970 969=head1 SEE ALSO
970
abfa405a 971L<perl>,
972L<SQL::Translator::Parser>,
973L<SQL::Translator::Producer>,
974L<Parse::RecDescent>
16dc9970 975