lib/SQL/Translator.pm

   1 package SQL::Translator;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Translator.pm,v 1.20 2003-04-07 16:18:15 dlc Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
   7 #                    darren chamberlain <darren@cpan.org>,
   8 #                    Chris Mungall <cjm@fruitfly.org>
   9 #
  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.
  13 #
  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.
  18 #
  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
  23 # -------------------------------------------------------------------
  24
  25 use strict;
  26 use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR );
  27 use base 'Class::Base';
  28
  29 $VERSION  = '0.01';
  30 $REVISION = sprintf "%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/;
  31 $DEBUG    = 0 unless defined $DEBUG;
  32 $ERROR    = "";
  33
  34 use Carp qw(carp);
  35
  36 use File::Spec::Functions qw(catfile);
  37 use File::Basename qw(dirname);
  38 use IO::Dir;
  39
  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;
  46
  47 # ----------------------------------------------------------------------
  48 # init([ARGS])
  49 #   The constructor.
  50 #
  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".
  54 #
  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.
  59 # ----------------------------------------------------------------------
  60 sub init {
  61     my ( $self, $config ) = @_;
  62
  63     #
  64     # Set the parser and producer.
  65     #
  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.
  69     #
  70     $self->parser  ($config->{'parser'}   || $config->{'from'} || $DEFAULT_SUB);
  71     $self->producer($config->{'producer'} || $config->{'to'}   || $DEFAULT_SUB);
  72
  73     #
  74     # Set the parser_args and producer_args
  75     #
  76     for my $pargs ( qw[ parser_args producer_args ] ) {
  77         $self->$pargs( $config->{$pargs} ) if defined $config->{ $pargs };
  78     }
  79
  80     #
  81     # Set the data source, if 'filename' or 'file' is provided.
  82     #
  83     $config->{'filename'} ||= $config->{'file'} || "";
  84     $self->filename( $config->{'filename'} ) if $config->{'filename'};
  85
  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 );
  92     }
  93
  94     #
  95     # Set various other options.
  96     #
  97     $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
  98
  99
 100     $self->add_drop_table( $config->{'add_drop_table'} );
 101
 102     $self->custom_translate( $config->{'xlate'} );
 103
 104     $self->no_comments( $config->{'no_comments'} );
 105
 106     $self->show_warnings( $config->{'show_warnings'} );
 107
 108     $self->trace( $config->{'trace'} );
 109
 110     return $self;
 111 }
 112
 113 # ----------------------------------------------------------------------
 114 # add_drop_table([$bool])
 115 # ----------------------------------------------------------------------
 116 sub 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
 125 # ----------------------------------------------------------------------
 126 # custom_translate([$bool])
 127 # ----------------------------------------------------------------------
 128 sub custom_translate {
 129     my $self = shift;
 130     $self->{'custom_translate'} = shift if @_;
 131     return $self->{'custom_translate'} || {};
 132 }
 133
 134 # ----------------------------------------------------------------------
 135 # no_comments([$bool])
 136 # ----------------------------------------------------------------------
 137 sub 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
 146
 147 # ----------------------------------------------------------------------
 148 # producer([$producer_spec])
 149 #
 150 # Get or set the producer for the current translator.
 151 # ----------------------------------------------------------------------
 152 sub producer {
 153     my $self = shift;
 154
 155     # producer as a mutator
 156     if (@_) {
 157         my $producer = shift;
 158
 159         # Passed a module name (string containing "::")
 160         if ($producer =~ /::/) {
 161             my $func_name;
 162
 163             # Module name was passed directly
 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.
 167             if (load($producer)) {
 168                 $func_name = "produce";
 169             }
 170
 171             # Module::function was passed
 172             else {
 173                 # Passed Module::Name::function; try to recover
 174                 my @func_parts = split /::/, $producer;
 175                 $func_name = pop @func_parts;
 176                 $producer = join "::", @func_parts;
 177
 178                 # If this doesn't work, then we have a legitimate
 179                 # problem.
 180                 load($producer) or die "Can't load $producer: $@";
 181             }
 182
 183             # get code reference and assign
 184             $self->{'producer'} = \&{ "$producer\::$func_name" };
 185             $self->{'producer_type'} = $producer;
 186             $self->debug("Got producer: $producer\::$func_name\n");
 187         }
 188
 189         # passed an anonymous subroutine reference
 190         elsif (isa($producer, 'CODE')) {
 191             $self->{'producer'} = $producer;
 192             $self->{'producer_type'} = "CODE";
 193             $self->debug("Got producer: code ref\n");
 194         }
 195
 196         # passed a string containing no "::"; relative package name
 197         else {
 198             my $Pp = sprintf "SQL::Translator::Producer::$producer";
 199             load($Pp) or die "Can't load $Pp: $@";
 200             $self->{'producer'} = \&{ "$Pp\::produce" };
 201             $self->{'producer_type'} = $Pp;
 202             $self->debug("Got producer: $Pp\n");
 203         }
 204
 205         # At this point, $self->{'producer'} contains a subroutine
 206         # reference that is ready to run
 207
 208         # Anything left?  If so, it's producer_args
 209         $self->producer_args(@_) if (@_);
 210     }
 211
 212     return $self->{'producer'};
 213 };
 214
 215 # ----------------------------------------------------------------------
 216 # producer_type()
 217 #
 218 # producer_type is an accessor that allows producer subs to get
 219 # information about their origin.  This is poptentially important;
 220 # since all producer subs are called as subroutine references, there is
 221 # no way for a producer to find out which package the sub lives in
 222 # originally, for example.
 223 # ----------------------------------------------------------------------
 224 sub producer_type { $_[0]->{'producer_type'} }
 225
 226 # ----------------------------------------------------------------------
 227 # producer_args([\%args])
 228 #
 229 # Arbitrary name => value pairs of paramters can be passed to a
 230 # producer using this method.
 231 #
 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.
 235 # ----------------------------------------------------------------------
 236 sub producer_args {
 237     my $self = shift;
 238     return $self->_args("producer", @_);
 239 }
 240
 241 # ----------------------------------------------------------------------
 242 # parser([$parser_spec])
 243 # ----------------------------------------------------------------------
 244 sub parser {
 245     my $self = shift;
 246
 247     # parser as a mutator
 248     if (@_) {
 249         my $parser = shift;
 250
 251         # Passed a module name (string containing "::")
 252         if ($parser =~ /::/) {
 253             my $func_name;
 254
 255             # Module name was passed directly
 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";
 261             }
 262
 263             # Module::function was passed
 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: $@";
 273             }
 274
 275             # get code reference and assign
 276             $self->{'parser'} = \&{ "$parser\::$func_name" };
 277             $self->{'parser_type'} = $parser;
 278             $self->debug("Got parser: $parser\::$func_name\n");
 279         }
 280
 281         # passed an anonymous subroutine reference
 282         elsif ( isa( $parser, 'CODE' ) ) {
 283             $self->{'parser'}      = $parser;
 284             $self->{'parser_type'} = "CODE";
 285             $self->debug("Got parser: code ref\n");
 286         }
 287
 288         # passed a string containing no "::"; relative package name
 289         else {
 290             my $Pp = "SQL::Translator::Parser::$parser";
 291             load( $Pp ) or die "Can't load $Pp: $@";
 292             $self->{'parser'}      = \&{ "$Pp\::parse" };
 293             $self->{'parser_type'} = $Pp;
 294             $self->debug("Got parser: $Pp\n");
 295         }
 296
 297         #
 298         # At this point, $self->{'parser'} contains a subroutine
 299         # reference that is ready to run
 300         #
 301         $self->parser_args( @_ ) if (@_);
 302     }
 303
 304     return $self->{'parser'};
 305 }
 306
 307 # ----------------------------------------------------------------------
 308 sub parser_type { $_[0]->{'parser_type'} }
 309
 310 sub parser_args {
 311     my $self = shift;
 312     return $self->_args("parser", @_);
 313 }
 314
 315 sub 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
 324
 325 # filename - get or set the filename
 326 sub 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     }
 342
 343     $self->{'filename'};
 344 }
 345
 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 # ----------------------------------------------------------------------
 353 sub data {
 354     my $self = shift;
 355
 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     }
 377
 378     # If we have a filename but no data yet, populate.
 379     if (not $self->{'data'} and my $filename = $self->filename) {
 380         $self->debug("Opening '$filename' to get contents.\n");
 381         local *FH;
 382         local $/;
 383         my $data;
 384
 385         unless (open FH, $filename) {
 386             return $self->error("Can't read file '$filename': $!");
 387         }
 388
 389         $data = <FH>;
 390         $self->{'data'} = \$data;
 391
 392         unless (close FH) {
 393             return $self->error("Can't close file '$filename': $!");
 394         }
 395     }
 396
 397     return $self->{'data'};
 398 }
 399
 400
 401 sub 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 # ----------------------------------------------------------------------
 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 # ----------------------------------------------------------------------
 425 sub translate {
 426     my $self = shift;
 427     my ($args, $parser, $parser_type, $producer, $producer_type);
 428     my ($parser_output, $producer_output);
 429
 430     # Parse arguments
 431     if (@_ == 1) {
 432         # Passed a reference to a hash?
 433         if (isa($_[0], 'HASH')) {
 434             # yep, a hashref
 435             $self->debug("translate: Got a hashref\n");
 436             $args = $_[0];
 437         }
 438
 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
 445         # Passed a reference to a string containing the data
 446         elsif (isa($_[0], 'SCALAR')) {
 447             # passed a ref to a string
 448             $self->debug("translate: Got a SCALAR reference (string)\n");
 449             $self->data($_[0]);
 450         }
 451
 452         # Not a reference; treat it as a filename
 453         elsif (! ref $_[0]) {
 454             # Not a ref, it's a filename
 455             $self->debug("translate: Got a filename\n");
 456             $self->filename($_[0]);
 457         }
 458
 459         # Passed something else entirely.
 460         else {
 461             # We're not impressed.  Take your empty string and leave.
 462             # return "";
 463
 464             # Actually, if data, parser, and producer are set, then we
 465             # can continue.  Too bad, because I like my comment
 466             # (above)...
 467             return "" unless ($self->data     &&
 468                               $self->producer &&
 469                               $self->parser);
 470         }
 471     }
 472     else {
 473         # You must pass in a hash, or you get nothing.
 474         return "" if @_ % 2;
 475         $args = { @_ };
 476     }
 477
 478     # ----------------------------------------------------------------------
 479     # Can specify the data to be transformed using "filename", "file",
 480     # "data", or "datasource".
 481     # ----------------------------------------------------------------------
 482     if (my $filename = ($args->{'filename'} || $args->{'file'})) {
 483         $self->filename($filename);
 484     }
 485
 486     if (my $data = ($args->{'data'} || $args->{'datasource'})) {
 487         $self->data($data);
 488     }
 489
 490     # ----------------------------------------------------------------
 491     # Get the data.
 492     # ----------------------------------------------------------------
 493     my $data = $self->data;
 494     unless (length $$data) {
 495         return $self->error("Empty data file!");
 496     }
 497
 498     # ----------------------------------------------------------------
 499     # Local reference to the parser subroutine
 500     # ----------------------------------------------------------------
 501     if ($parser = ($args->{'parser'} || $args->{'from'})) {
 502         $self->parser($parser);
 503     }
 504     $parser      = $self->parser;
 505     $parser_type = $self->parser_type;
 506
 507     # ----------------------------------------------------------------
 508     # Local reference to the producer subroutine
 509     # ----------------------------------------------------------------
 510     if ($producer = ($args->{'producer'} || $args->{'to'})) {
 511         $self->producer($producer);
 512     }
 513     $producer      = $self->producer;
 514     $producer_type = $self->producer_type;
 515
 516     # ----------------------------------------------------------------
 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.
 522     # ----------------------------------------------------------------
 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";
 527         return $self->error($msg);
 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";
 534         return $self->error($msg);
 535     }
 536
 537     return $producer_output;
 538 }
 539
 540 # ----------------------------------------------------------------------
 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 # ----------------------------------------------------------------------
 560 sub list_parsers {
 561     return shift->_list("parser");
 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 # ----------------------------------------------------------------------
 570 sub list_producers {
 571     return shift->_list("producer");
 572 }
 573
 574
 575 # ======================================================================
 576 # Private Methods
 577 # ======================================================================
 578
 579 # ----------------------------------------------------------------------
 580 # _args($type, \%args);
 581 #
 582 # Gets or sets ${type}_args.  Called by parser_args and producer_args.
 583 # ----------------------------------------------------------------------
 584 sub _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};
 607 }
 608
 609
 610 # ----------------------------------------------------------------------
 611 # _list($type)
 612 # ----------------------------------------------------------------------
 613 sub _list {
 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     }
 632
 633     return keys %found;
 634 }
 635
 636 # ----------------------------------------------------------------------
 637 # load($module)
 638 #
 639 # Loads a Perl module.  Short circuits if a module is already loaded.
 640 # ----------------------------------------------------------------------
 641 sub load {
 642     my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
 643     return 1 if $INC{$module};
 644
 645     eval { require $module };
 646
 647     return __PACKAGE__->error($@) if ($@);
 648     return 1;
 649 }
 650
 651 # ----------------------------------------------------------------------
 652 # isa($ref, $type)
 653 #
 654 # Calls UNIVERSAL::isa($ref, $type).  I think UNIVERSAL::isa is ugly,
 655 # but I like function overhead.
 656 # ----------------------------------------------------------------------
 657 sub isa($$) {
 658     my ($ref, $type) = @_;
 659     return UNIVERSAL::isa($ref, $type);
 660 }
 661
 662 1;
 663 #-----------------------------------------------------
 664 # Rescue the drowning and tie your shoestrings.
 665 # Henry David Thoreau
 666 #-----------------------------------------------------
 667
 668 __END__
 669
 670 =head1 NAME
 671
 672 SQL::Translator - convert schema from one database to another
 673
 674 =head1 SYNOPSIS
 675
 676   use SQL::Translator;
 677
 678   my $translator     = SQL::Translator->new(
 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
 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
 696 This module attempts to simplify the task of converting one database
 697 create syntax to another through the use of Parsers (which understand
 698 the source format) and Producers (which understand the destination
 699 format).  The idea is that any Parser can be used with any Producer in
 700 the conversion process.  So, if you wanted Postgres-to-Oracle, you
 701 would use the Postgres parser and the Oracle producer.
 702
 703 =head1 CONSTRUCTOR
 704
 705 The constructor is called B<new>, and accepts a optional hash of options.
 706 Valid options are:
 707
 708 =over 4
 709
 710 =item *
 711
 712 parser / from
 713
 714 =item *
 715
 716 parser_args
 717
 718 =item *
 719
 720 producer / to
 721
 722 =item *
 723
 724 producer_args
 725
 726 =item *
 727
 728 filename / file
 729
 730 =item *
 731
 732 data
 733
 734 =item *
 735
 736 debug
 737
 738 =back
 739
 740 All options are, well, optional; these attributes can be set via
 741 instance methods.  Internally, they are; no (non-syntactical)
 742 advantage is gained by passing options to the constructor.
 743
 744 =head1 METHODS
 745
 746 =head2 B<add_drop_table>
 747
 748 Toggles whether or not to add "DROP TABLE" statements just before the
 749 create definitions.
 750
 751 =head2 B<custom_translate>
 752
 753 Allows the user to override default translation of fields.  For example,
 754 if a MySQL "text" field would normally be converted to a "long" for Oracle,
 755 the user could specify to change it to a "CLOB."  Accepts a hashref where
 756 keys are the "from" value and values are the "to," returns the current
 757 value of the field.
 758
 759 =head2 B<no_comments>
 760
 761 Toggles whether to print comments in the output.  Accepts a true or false
 762 value, returns the current value.
 763
 764 =head2 B<producer>
 765
 766 The B<producer> method is an accessor/mutator, used to retrieve or
 767 define what subroutine is called to produce the output.  A subroutine
 768 defined as a producer will be invoked as a function (I<not a method>)
 769 and passed 2 parameters: its container C<SQL::Translator> instance and a
 770 data structure.  It is expected that the function transform the data
 771 structure to a string.  The C<SQL::Transformer> instance is provided for
 772 informational purposes; for example, the type of the parser can be
 773 retrieved using the B<parser_type> method, and the B<error> and
 774 B<debug> methods can be called when needed.
 775
 776 When defining a producer, one of several things can be passed in:  A
 777 module name (e.g., C<My::Groovy::Producer>, a module name relative to
 778 the C<SQL::Translator::Producer> namespace (e.g., MySQL), a module
 779 name and function combination (C<My::Groovy::Producer::transmogrify>),
 780 or a reference to an anonymous subroutine.  If a full module name is
 781 passed in (for the purposes of this method, a string containing "::"
 782 is considered to be a module name), it is treated as a package, and a
 783 function called "produce" will be invoked: C<$modulename::produce>.
 784 If $modulename cannot be loaded, the final portion is stripped off and
 785 treated as a function.  In other words, if there is no file named
 786 F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
 787 to load F<My/Groovy/Producer.pm> and use transmogrify as the name of
 788 the function, instead of the default "produce".
 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
 807 There is also a method named B<producer_type>, which is a string
 808 containing the classname to which the above B<produce> function
 809 belongs.  In the case of anonymous subroutines, this method returns
 810 the string "CODE".
 811
 812 Finally, there is a method named B<producer_args>, which is both an
 813 accessor and a mutator.  Arbitrary data may be stored in name => value
 814 pairs 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
 822 Extra data passed to the B<producer> method is passed to
 823 B<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
 833 The B<parser> method defines or retrieves a subroutine that will be
 834 called to perform the parsing.  The basic idea is the same as that of
 835 B<producer> (see above), except the default subroutine name is
 836 "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
 837 Also, the parser subroutine will be passed a string containing the
 838 entirety 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
 853 There is also B<parser_type> and B<parser_args>, which perform
 854 analogously to B<producer_type> and B<producer_args>
 855
 856 =head2 B<show_warnings>
 857
 858 Toggles whether to print warnings of name conflicts, identifier
 859 mutations, etc.  Probably only generated by producers to let the user
 860 know when something won't translate very smoothly (e.g., MySQL "enum"
 861 fields into Oracle).  Accepts a true or false value, returns the
 862 current value.
 863
 864 =head2 B<translate>
 865
 866 The B<translate> method calls the subroutines referenced by the
 867 B<parser> and B<producer> data members (described above).  It accepts
 868 as arguments a number of things, in key => value format, including
 869 (potentially) a parser and a producer (they are passed directly to the
 870 B<parser> and B<producer> methods).
 871
 872 Here is how the parameter list to B<translate> is parsed:
 873
 874 =over
 875
 876 =item *
 877
 878 1 argument means it's the data to be parsed; which could be a string
 879 (filename) or a reference to a scalar (a string stored in memory), or a
 880 reference 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
 891 More than 1 argument means its a hash of things, and it might be
 892 setting 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
 906 You get the idea.
 907
 908 =back
 909
 910 =head2 B<filename>, B<data>
 911
 912 Using the B<filename> method, the filename of the data to be parsed
 913 can be set. This method can be used in conjunction with the B<data>
 914 method, below.  If both the B<filename> and B<data> methods are
 915 invoked as mutators, the data set in the B<data> method is used.
 916
 917     $tr->filename("/my/data/files/create.sql");
 918
 919 or:
 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
 928 B<filename> takes a string, which is interpreted as a filename.
 929 B<data> takes a reference to a string, which is used as the data to be
 930 parsed.  If a filename is set, then that file is opened and read when
 931 the B<translate> method is called, as long as the data instance
 932 variable is not set.
 933
 934 =pod
 935
 936 =head2 B<trace>
 937
 938 Turns on/off the tracing option of Parse::RecDescent.
 939
 940 =pod
 941
 942 =head1 AUTHORS
 943
 944 Ken Y. Clark, E<lt>kclark@cpan.orgE<gt>,
 945 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 946 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>,
 947 Allen Day E<lt>allenday@users.sourceforge.netE<gt>
 948
 949 =head1 COPYRIGHT
 950
 951 This program is free software; you can redistribute it and/or modify
 952 it under the terms of the GNU General Public License as published by
 953 the Free Software Foundation; version 2.
 954
 955 This program is distributed in the hope that it will be useful, but
 956 WITHOUT ANY WARRANTY; without even the implied warranty of
 957 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 958 General Public License for more details.
 959
 960 You should have received a copy of the GNU General Public License
 961 along with this program; if not, write to the Free Software
 962 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
 963 USA
 964
 965 =head1 BUGS
 966
 967 Please use http://rt.cpan.org/ for reporting bugs.
 968
 969 =head1 SEE ALSO
 970
 971 L<perl>,
 972 L<SQL::Translator::Parser>,
 973 L<SQL::Translator::Producer>,
 974 L<Parse::RecDescent>
 975