lib/SQL/Translator.pm

   1 package SQL::Translator;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Translator.pm,v 1.17 2003-02-26 13:08:59 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.17 $ =~ /(\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
 243 # ----------------------------------------------------------------------
 244 # parser([$parser_spec])
 245 # ----------------------------------------------------------------------
 246 sub parser {
 247     my $self = shift;
 248
 249     # parser as a mutator
 250     if (@_) {
 251         my $parser = shift;
 252
 253         # Passed a module name (string containing "::")
 254         if ($parser =~ /::/) {
 255             my $func_name;
 256
 257             # Module name was passed directly
 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";
 263             }
 264
 265             # Module::function was passed
 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: $@";
 275             }
 276
 277             # get code reference and assign
 278             $self->{'parser'} = \&{ "$parser\::$func_name" };
 279             $self->{'parser_type'} = $parser;
 280             $self->debug("Got parser: $parser\::$func_name\n");
 281         }
 282
 283         # passed an anonymous subroutine reference
 284         elsif ( isa( $parser, 'CODE' ) ) {
 285             $self->{'parser'}      = $parser;
 286             $self->{'parser_type'} = "CODE";
 287             $self->debug("Got parser: code ref\n");
 288         }
 289
 290         # passed a string containing no "::"; relative package name
 291         else {
 292             my $Pp = "SQL::Translator::Parser::$parser";
 293             load( $Pp ) or die "Can't load $Pp: $@";
 294             $self->{'parser'}      = \&{ "$Pp\::parse" };
 295             $self->{'parser_type'} = $Pp;
 296             $self->debug("Got parser: $Pp\n");
 297         }
 298
 299         #
 300         # At this point, $self->{'parser'} contains a subroutine
 301         # reference that is ready to run
 302         #
 303         $self->parser_args( @_ ) if (@_);
 304     }
 305
 306     return $self->{'parser'};
 307 }
 308
 309 # ----------------------------------------------------------------------
 310 sub parser_type { $_[0]->{'parser_type'} }
 311
 312 sub parser_args {
 313     my $self = shift;
 314     return $self->_args("parser", @_);
 315 }
 316
 317 sub 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
 326
 327 # filename - get or set the filename
 328 sub 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     }
 344
 345     $self->{'filename'};
 346 }
 347
 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 # ----------------------------------------------------------------------
 355 sub data {
 356     my $self = shift;
 357
 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     }
 379
 380     # If we have a filename but no data yet, populate.
 381     if (not $self->{'data'} and my $filename = $self->filename) {
 382         $self->debug("Opening '$filename' to get contents.\n");
 383         local *FH;
 384         local $/;
 385         my $data;
 386
 387         unless (open FH, $filename) {
 388             return $self->error("Can't read file '$filename': $!");
 389         }
 390
 391         $data = <FH>;
 392         $self->{'data'} = \$data;
 393
 394         unless (close FH) {
 395             return $self->error("Can't close file '$filename': $!");
 396         }
 397     }
 398
 399     return $self->{'data'};
 400 }
 401
 402
 403 sub 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 # ----------------------------------------------------------------------
 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 # ----------------------------------------------------------------------
 427 sub translate {
 428     my $self = shift;
 429     my ($args, $parser, $parser_type, $producer, $producer_type);
 430     my ($parser_output, $producer_output);
 431
 432     # Parse arguments
 433     if (@_ == 1) {
 434         # Passed a reference to a hash?
 435         if (isa($_[0], 'HASH')) {
 436             # yep, a hashref
 437             $self->debug("translate: Got a hashref\n");
 438             $args = $_[0];
 439         }
 440
 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
 447         # Passed a reference to a string containing the data
 448         elsif (isa($_[0], 'SCALAR')) {
 449             # passed a ref to a string
 450             $self->debug("translate: Got a SCALAR reference (string)\n");
 451             $self->data($_[0]);
 452         }
 453
 454         # Not a reference; treat it as a filename
 455         elsif (! ref $_[0]) {
 456             # Not a ref, it's a filename
 457             $self->debug("translate: Got a filename\n");
 458             $self->filename($_[0]);
 459         }
 460
 461         # Passed something else entirely.
 462         else {
 463             # We're not impressed.  Take your empty string and leave.
 464             # return "";
 465
 466             # Actually, if data, parser, and producer are set, then we
 467             # can continue.  Too bad, because I like my comment
 468             # (above)...
 469             return "" unless ($self->data     &&
 470                               $self->producer &&
 471                               $self->parser);
 472         }
 473     }
 474     else {
 475         # You must pass in a hash, or you get nothing.
 476         return "" if @_ % 2;
 477         $args = { @_ };
 478     }
 479
 480     # ----------------------------------------------------------------------
 481     # Can specify the data to be transformed using "filename", "file",
 482     # "data", or "datasource".
 483     # ----------------------------------------------------------------------
 484     if (my $filename = ($args->{'filename'} || $args->{'file'})) {
 485         $self->filename($filename);
 486     }
 487
 488     if (my $data = ($self->{'data'} || $self->{'datasource'})) {
 489         $self->data($data);
 490     }
 491
 492     # ----------------------------------------------------------------
 493     # Get the data.
 494     # ----------------------------------------------------------------
 495     my $data = $self->data;
 496     unless (length $$data) {
 497         return $self->error("Empty data file!");
 498     }
 499
 500     # ----------------------------------------------------------------
 501     # Local reference to the parser subroutine
 502     # ----------------------------------------------------------------
 503     if ($parser = ($args->{'parser'} || $args->{'from'})) {
 504         $self->parser($parser);
 505     }
 506     $parser      = $self->parser;
 507     $parser_type = $self->parser_type;
 508
 509     # ----------------------------------------------------------------
 510     # Local reference to the producer subroutine
 511     # ----------------------------------------------------------------
 512     if ($producer = ($args->{'producer'} || $args->{'to'})) {
 513         $self->producer($producer);
 514     }
 515     $producer      = $self->producer;
 516     $producer_type = $self->producer_type;
 517
 518     # ----------------------------------------------------------------
 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.
 524     # ----------------------------------------------------------------
 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";
 529         return $self->error($msg);
 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";
 536         return $self->error($msg);
 537     }
 538
 539     return $producer_output;
 540 }
 541
 542 # ----------------------------------------------------------------------
 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 # ----------------------------------------------------------------------
 562 sub 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 # ----------------------------------------------------------------------
 572 sub list_producers {
 573     return _list("producers");
 574 }
 575
 576
 577 # ======================================================================
 578 # Private Methods
 579 # ======================================================================
 580
 581 # ----------------------------------------------------------------------
 582 # _args($type, \%args);
 583 #
 584 # Gets or sets ${type}_args.  Called by parser_args and producer_args.
 585 # ----------------------------------------------------------------------
 586 sub _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};
 609 }
 610
 611
 612 # ----------------------------------------------------------------------
 613 # _list($type)
 614 # ----------------------------------------------------------------------
 615 sub _list {
 616     my $type = ucfirst lc $_[0] || return ();
 617
 618     load("SQL::Translator::$type");
 619     my $path = catfile(dirname($INC{'SQL/Translator/$type.pm'}), $type);
 620     my $dh = IO::Dir->new($path);
 621
 622     return map { join "::", "SQL::Translator::$type", $_ }
 623                  grep /\.pm$/, $dh->read;
 624 }
 625
 626 # ----------------------------------------------------------------------
 627 # load($module)
 628 #
 629 # Loads a Perl module.  Short circuits if a module is already loaded.
 630 # ----------------------------------------------------------------------
 631 sub 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;
 639 }
 640
 641 # ----------------------------------------------------------------------
 642 # isa($ref, $type)
 643 #
 644 # Calls UNIVERSAL::isa($ref, $type).  I think UNIVERSAL::isa is ugly,
 645 # but I like function overhead.
 646 # ----------------------------------------------------------------------
 647 sub isa($$) {
 648     my ($ref, $type) = @_;
 649     return UNIVERSAL::isa($ref, $type);
 650 }
 651
 652 1;
 653 #-----------------------------------------------------
 654 # Rescue the drowning and tie your shoestrings.
 655 # Henry David Thoreau
 656 #-----------------------------------------------------
 657
 658 __END__
 659
 660 =head1 NAME
 661
 662 SQL::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
 687 This module attempts to simplify the task of converting one database
 688 create syntax to another through the use of Parsers (which understand
 689 the source format) and Producers (which understand the destination
 690 format).  The idea is that any Parser can be used with any Producer in
 691 the conversion process.  So, if you wanted Postgres-to-Oracle, you
 692 would use the Postgres parser and the Oracle producer.
 693
 694 =head1 CONSTRUCTOR
 695
 696 The constructor is called B<new>, and accepts a optional hash of options.
 697 Valid options are:
 698
 699 =over 4
 700
 701 =item *
 702
 703 parser / from
 704
 705 =item *
 706
 707 parser_args
 708
 709 =item *
 710
 711 producer / to
 712
 713 =item *
 714
 715 producer_args
 716
 717 =item *
 718
 719 filename / file
 720
 721 =item *
 722
 723 data
 724
 725 =item *
 726
 727 debug
 728
 729 =back
 730
 731 All options are, well, optional; these attributes can be set via
 732 instance methods.  Internally, they are; no (non-syntactical)
 733 advantage is gained by passing options to the constructor.
 734
 735 =head1 METHODS
 736
 737 =head2 B<add_drop_table>
 738
 739 Toggles whether or not to add "DROP TABLE" statements just before the
 740 create definitions.
 741
 742 =head2 B<custom_translate>
 743
 744 Allows the user to override default translation of fields.  For example,
 745 if a MySQL "text" field would normally be converted to a "long" for Oracle,
 746 the user could specify to change it to a "CLOB."  Accepts a hashref where
 747 keys are the "from" value and values are the "to," returns the current
 748 value of the field.
 749
 750 =head2 B<no_comments>
 751
 752 Toggles whether to print comments in the output.  Accepts a true or false
 753 value, returns the current value.
 754
 755 =head2 B<producer>
 756
 757 The B<producer> method is an accessor/mutator, used to retrieve or
 758 define what subroutine is called to produce the output.  A subroutine
 759 defined as a producer will be invoked as a function (I<not a method>)
 760 and passed 2 parameters: its container C<SQL::Translator> instance and a
 761 data structure.  It is expected that the function transform the data
 762 structure to a string.  The C<SQL::Transformer> instance is provided for
 763 informational purposes; for example, the type of the parser can be
 764 retrieved using the B<parser_type> method, and the B<error> and
 765 B<debug> methods can be called when needed.
 766
 767 When defining a producer, one of several things can be passed in:  A
 768 module name (e.g., C<My::Groovy::Producer>, a module name relative to
 769 the C<SQL::Translator::Producer> namespace (e.g., MySQL), a module
 770 name and function combination (C<My::Groovy::Producer::transmogrify>),
 771 or a reference to an anonymous subroutine.  If a full module name is
 772 passed in (for the purposes of this method, a string containing "::"
 773 is considered to be a module name), it is treated as a package, and a
 774 function called "produce" will be invoked: C<$modulename::produce>.
 775 If $modulename cannot be loaded, the final portion is stripped off and
 776 treated as a function.  In other words, if there is no file named
 777 F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
 778 to load F<My/Groovy/Producer.pm> and use transmogrify as the name of
 779 the function, instead of the default "produce".
 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
 798 There is also a method named B<producer_type>, which is a string
 799 containing the classname to which the above B<produce> function
 800 belongs.  In the case of anonymous subroutines, this method returns
 801 the string "CODE".
 802
 803 Finally, there is a method named B<producer_args>, which is both an
 804 accessor and a mutator.  Arbitrary data may be stored in name => value
 805 pairs 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
 813 Extra data passed to the B<producer> method is passed to
 814 B<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
 824 The B<parser> method defines or retrieves a subroutine that will be
 825 called to perform the parsing.  The basic idea is the same as that of
 826 B<producer> (see above), except the default subroutine name is
 827 "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
 828 Also, the parser subroutine will be passed a string containing the
 829 entirety 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
 844 There is also B<parser_type> and B<parser_args>, which perform
 845 analogously to B<producer_type> and B<producer_args>
 846
 847 =head2 B<show_warnings>
 848
 849 Toggles whether to print warnings of name conflicts, identifier
 850 mutations, etc.  Probably only generated by producers to let the user
 851 know when something won't translate very smoothly (e.g., MySQL "enum"
 852 fields into Oracle).  Accepts a true or false value, returns the
 853 current value.
 854
 855 =head2 B<translate>
 856
 857 The B<translate> method calls the subroutines referenced by the
 858 B<parser> and B<producer> data members (described above).  It accepts
 859 as arguments a number of things, in key => value format, including
 860 (potentially) a parser and a producer (they are passed directly to the
 861 B<parser> and B<producer> methods).
 862
 863 Here is how the parameter list to B<translate> is parsed:
 864
 865 =over
 866
 867 =item *
 868
 869 1 argument means it's the data to be parsed; which could be a string
 870 (filename) or a reference to a scalar (a string stored in memory), or a
 871 reference 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
 882 More than 1 argument means its a hash of things, and it might be
 883 setting 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
 897 You get the idea.
 898
 899 =back
 900
 901 =head2 B<filename>, B<data>
 902
 903 Using the B<filename> method, the filename of the data to be parsed
 904 can be set. This method can be used in conjunction with the B<data>
 905 method, below.  If both the B<filename> and B<data> methods are
 906 invoked as mutators, the data set in the B<data> method is used.
 907
 908     $tr->filename("/my/data/files/create.sql");
 909
 910 or:
 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
 919 B<filename> takes a string, which is interpreted as a filename.
 920 B<data> takes a reference to a string, which is used as the data to be
 921 parsed.  If a filename is set, then that file is opened and read when
 922 the B<translate> method is called, as long as the data instance
 923 variable is not set.
 924
 925 =pod
 926
 927 =head2 B<trace>
 928
 929 Turns on/off the tracing option of Parse::RecDescent.
 930
 931 =pod
 932
 933 =head1 AUTHORS
 934
 935 Ken Y. Clark, E<lt>kclark@cpan.orgE<gt>,
 936 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 937 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>,
 938 Allen Day E<lt>allenday@users.sourceforge.netE<gt>
 939
 940 =head1 COPYRIGHT
 941
 942 This program is free software; you can redistribute it and/or modify
 943 it under the terms of the GNU General Public License as published by
 944 the Free Software Foundation; version 2.
 945
 946 This program is distributed in the hope that it will be useful, but
 947 WITHOUT ANY WARRANTY; without even the implied warranty of
 948 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 949 General Public License for more details.
 950
 951 You should have received a copy of the GNU General Public License
 952 along with this program; if not, write to the Free Software
 953 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
 954 USA
 955
 956 =head1 SEE ALSO
 957
 958 L<perl>,
 959 L<SQL::Translator::Parser>,
 960 L<SQL::Translator::Producer>,
 961 L<Parse::RecDescent>
 962