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