1 package SQL::Translator;
3 # ----------------------------------------------------------------------
4 # $Id: Translator.pm,v 1.68 2005-06-09 02:02:00 grommit Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2002-4 The SQLFairy Authors
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
24 use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR );
25 use base 'Class::Base';
30 $REVISION = sprintf "%d.%02d", q$Revision: 1.68 $ =~ /(\d+)\.(\d+)/;
31 $DEBUG = 0 unless defined $DEBUG;
39 use File::Spec::Functions qw(catfile);
40 use File::Basename qw(dirname);
42 use SQL::Translator::Schema;
44 # ----------------------------------------------------------------------
45 # The default behavior is to "pass through" values (note that the
46 # SQL::Translator instance is the first value ($_[0]), and the stuff
47 # to be parsed is the second value ($_[1])
48 # ----------------------------------------------------------------------
49 $DEFAULT_SUB = sub { $_[0]->schema } unless defined $DEFAULT_SUB;
51 # ----------------------------------------------------------------------
55 # new takes an optional hash of arguments. These arguments may
56 # include a parser, specified with the keys "parser" or "from",
57 # and a producer, specified with the keys "producer" or "to".
59 # The values that can be passed as the parser or producer are
60 # given directly to the parser or producer methods, respectively.
61 # See the appropriate method description below for details about
62 # what each expects/accepts.
63 # ----------------------------------------------------------------------
65 my ( $self, $config ) = @_;
67 # Set the parser and producer.
69 # If a 'parser' or 'from' parameter is passed in, use that as the
70 # parser; if a 'producer' or 'to' parameter is passed in, use that
71 # as the producer; both default to $DEFAULT_SUB.
73 $self->parser ($config->{'parser'} || $config->{'from'} || $DEFAULT_SUB);
74 $self->producer($config->{'producer'} || $config->{'to'} || $DEFAULT_SUB);
77 # Set up callbacks for formatting of pk,fk,table,package names in producer
78 # MOVED TO PRODUCER ARGS
80 #$self->format_table_name($config->{'format_table_name'});
81 #$self->format_package_name($config->{'format_package_name'});
82 #$self->format_fk_name($config->{'format_fk_name'});
83 #$self->format_pk_name($config->{'format_pk_name'});
86 # Set the parser_args and producer_args
88 for my $pargs ( qw[ parser_args producer_args ] ) {
89 $self->$pargs( $config->{$pargs} ) if defined $config->{ $pargs };
93 # Initialize the filters.
95 if ( $config->{filters} && ref $config->{filters} eq "ARRAY" ) {
96 $self->filters( @{$config->{filters}} )
97 || return $self->error('Error inititializing filters: '.$self->error);
101 # Set the data source, if 'filename' or 'file' is provided.
103 $config->{'filename'} ||= $config->{'file'} || "";
104 $self->filename( $config->{'filename'} ) if $config->{'filename'};
107 # Finally, if there is a 'data' parameter, use that in
108 # preference to filename and file
110 if ( my $data = $config->{'data'} ) {
111 $self->data( $data );
115 # Set various other options.
117 $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
119 $self->add_drop_table( $config->{'add_drop_table'} );
121 $self->no_comments( $config->{'no_comments'} );
123 $self->show_warnings( $config->{'show_warnings'} );
125 $self->trace( $config->{'trace'} );
127 $self->validate( $config->{'validate'} );
132 # ----------------------------------------------------------------------
133 # add_drop_table([$bool])
134 # ----------------------------------------------------------------------
137 if ( defined (my $arg = shift) ) {
138 $self->{'add_drop_table'} = $arg ? 1 : 0;
140 return $self->{'add_drop_table'} || 0;
143 # ----------------------------------------------------------------------
144 # no_comments([$bool])
145 # ----------------------------------------------------------------------
149 if ( defined $arg ) {
150 $self->{'no_comments'} = $arg ? 1 : 0;
152 return $self->{'no_comments'} || 0;
156 # ----------------------------------------------------------------------
157 # producer([$producer_spec])
159 # Get or set the producer for the current translator.
160 # ----------------------------------------------------------------------
164 path => "SQL::Translator::Producer",
165 default_sub => "produce",
169 # ----------------------------------------------------------------------
172 # producer_type is an accessor that allows producer subs to get
173 # information about their origin. This is poptentially important;
174 # since all producer subs are called as subroutine references, there is
175 # no way for a producer to find out which package the sub lives in
176 # originally, for example.
177 # ----------------------------------------------------------------------
178 sub producer_type { $_[0]->{'producer_type'} }
180 # ----------------------------------------------------------------------
181 # producer_args([\%args])
183 # Arbitrary name => value pairs of paramters can be passed to a
184 # producer using this method.
186 # If the first argument passed in is undef, then the hash of arguments
187 # is cleared; all subsequent elements are added to the hash of name,
188 # value pairs stored as producer_args.
189 # ----------------------------------------------------------------------
190 sub producer_args { shift->_args("producer", @_); }
192 # ----------------------------------------------------------------------
193 # parser([$parser_spec])
194 # ----------------------------------------------------------------------
198 path => "SQL::Translator::Parser",
199 default_sub => "parse",
203 sub parser_type { $_[0]->{'parser_type'}; }
205 sub parser_args { shift->_args("parser", @_); }
207 # ----------------------------------------------------------------------
209 # $sqlt->filters => [
211 # [ "NormalizeNames", field => "lc", tabel => "ucfirst" ],
214 # "TEXT" => "BIGTEXT",
217 # ----------------------------------------------------------------------
220 my $filters = $self->{filters} ||= [];
221 return @$filters unless @_;
223 # Set. Convert args to list of [\&code,@args]
225 my ($filt,@args) = ref($_) eq "ARRAY" ? @$_ : $_;
226 if ( isa($filt,"CODE") ) {
227 push @$filters, [$filt,@args];
231 $self->debug("Adding $filt filter. Args:".Dumper(\@args)."\n");
232 $filt = _load_sub("$filt\::filter", "SQL::Translator::Filter")
233 || return $self->error(__PACKAGE__->error);
234 push @$filters, [$filt,@args];
240 # ----------------------------------------------------------------------
244 if ( defined $arg ) {
245 $self->{'show_warnings'} = $arg ? 1 : 0;
247 return $self->{'show_warnings'} || 0;
251 # filename - get or set the filename
255 my $filename = shift;
257 my $msg = "Cannot use directory '$filename' as input source";
258 return $self->error($msg);
259 } elsif (ref($filename) eq 'ARRAY') {
260 $self->{'filename'} = $filename;
261 $self->debug("Got array of files: ".join(', ',@$filename)."\n");
262 } elsif (-f _ && -r _) {
263 $self->{'filename'} = $filename;
264 $self->debug("Got filename: '$self->{'filename'}'\n");
266 my $msg = "Cannot use '$filename' as input source: ".
267 "file does not exist or is not readable.";
268 return $self->error($msg);
275 # ----------------------------------------------------------------------
278 # if $self->{'data'} is not set, but $self->{'filename'} is, then
279 # $self->{'filename'} is opened and read, with the results put into
281 # ----------------------------------------------------------------------
285 # Set $self->{'data'} based on what was passed in. We will
286 # accept a number of things; do our best to get it right.
289 if (isa($data, "SCALAR")) {
290 $self->{'data'} = $data;
293 if (isa($data, 'ARRAY')) {
294 $data = join '', @$data;
296 elsif (isa($data, 'GLOB')) {
300 elsif (! ref $data && @_) {
301 $data = join '', $data, @_;
303 $self->{'data'} = \$data;
307 # If we have a filename but no data yet, populate.
308 if (not $self->{'data'} and my $filename = $self->filename) {
309 $self->debug("Opening '$filename' to get contents.\n");
314 my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
316 foreach my $file (@files) {
317 unless (open FH, $file) {
318 return $self->error("Can't read file '$file': $!");
324 return $self->error("Can't close file '$file': $!");
328 $self->{'data'} = \$data;
331 return $self->{'data'};
334 # ----------------------------------------------------------------------
337 # Deletes the existing Schema object so that future calls to translate
338 # don't append to the existing.
341 $self->{'schema'} = undef;
345 # ----------------------------------------------------------------------
348 # Returns the SQL::Translator::Schema object
352 unless ( defined $self->{'schema'} ) {
353 $self->{'schema'} = SQL::Translator::Schema->new(
358 return $self->{'schema'};
361 # ----------------------------------------------------------------------
365 if ( defined $arg ) {
366 $self->{'trace'} = $arg ? 1 : 0;
368 return $self->{'trace'} || 0;
371 # ----------------------------------------------------------------------
372 # translate([source], [\%args])
374 # translate does the actual translation. The main argument is the
375 # source of the data to be translated, which can be a filename, scalar
376 # reference, or glob reference.
378 # Alternatively, translate takes optional arguements, which are passed
379 # to the appropriate places. Most notable of these arguments are
380 # parser and producer, which can be used to set the parser and
381 # producer, respectively. This is the applications last chance to set
384 # translate returns a string.
385 # ----------------------------------------------------------------------
388 my ($args, $parser, $parser_type, $producer, $producer_type);
389 my ($parser_output, $producer_output);
393 # Passed a reference to a hash?
394 if (isa($_[0], 'HASH')) {
396 $self->debug("translate: Got a hashref\n");
400 # Passed a GLOB reference, i.e., filehandle
401 elsif (isa($_[0], 'GLOB')) {
402 $self->debug("translate: Got a GLOB reference\n");
406 # Passed a reference to a string containing the data
407 elsif (isa($_[0], 'SCALAR')) {
408 # passed a ref to a string
409 $self->debug("translate: Got a SCALAR reference (string)\n");
413 # Not a reference; treat it as a filename
414 elsif (! ref $_[0]) {
415 # Not a ref, it's a filename
416 $self->debug("translate: Got a filename\n");
417 $self->filename($_[0]);
420 # Passed something else entirely.
422 # We're not impressed. Take your empty string and leave.
425 # Actually, if data, parser, and producer are set, then we
426 # can continue. Too bad, because I like my comment
428 return "" unless ($self->data &&
434 # You must pass in a hash, or you get nothing.
439 # ----------------------------------------------------------------------
440 # Can specify the data to be transformed using "filename", "file",
441 # "data", or "datasource".
442 # ----------------------------------------------------------------------
443 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
444 $self->filename($filename);
447 if (my $data = ($args->{'data'} || $args->{'datasource'})) {
451 # ----------------------------------------------------------------
453 # ----------------------------------------------------------------
454 my $data = $self->data;
456 # ----------------------------------------------------------------
457 # Local reference to the parser subroutine
458 # ----------------------------------------------------------------
459 if ($parser = ($args->{'parser'} || $args->{'from'})) {
460 $self->parser($parser);
462 $parser = $self->parser;
463 $parser_type = $self->parser_type;
465 # ----------------------------------------------------------------
466 # Local reference to the producer subroutine
467 # ----------------------------------------------------------------
468 if ($producer = ($args->{'producer'} || $args->{'to'})) {
469 $self->producer($producer);
471 $producer = $self->producer;
472 $producer_type = $self->producer_type;
474 # ----------------------------------------------------------------
475 # Execute the parser, the filters and then execute the producer.
476 # Allowances are made for each piece to die, or fail to compile,
477 # since the referenced subroutines could be almost anything. In
478 # the future, each of these might happen in a Safe environment,
479 # depending on how paranoid we want to be.
480 # ----------------------------------------------------------------
483 unless ( defined $self->{'schema'} ) {
484 eval { $parser_output = $parser->($self, $$data) };
485 if ($@ || ! $parser_output) {
486 my $msg = sprintf "translate: Error with parser '%s': %s",
487 $parser_type, ($@) ? $@ : " no results";
488 return $self->error($msg);
491 $self->debug("Schema =\n", Dumper($self->schema), "\n");
493 # Validate the schema if asked to.
494 if ($self->validate) {
495 my $schema = $self->schema;
496 return $self->error('Invalid schema') unless $schema->is_valid;
501 foreach ($self->filters) {
503 my ($code,@args) = @$_;
504 eval { $code->($self->schema, @args) };
505 my $err = $@ || $self->error || 0;
506 return $self->error("Error with filter $filt_num : $err") if $err;
510 eval { $producer_output = $producer->($self) };
511 if ($@ || ! $producer_output) {
512 my $err = $@ || $self->error || "no results";
513 my $msg = "translate: Error with producer '$producer_type': $err";
514 return $self->error($msg);
517 return $producer_output;
520 # ----------------------------------------------------------------------
523 # Hacky sort of method to list all available parsers. This has
526 # - Only finds things in the SQL::Translator::Parser namespace
528 # - Only finds things that are located in the same directory
529 # as SQL::Translator::Parser. Yeck.
531 # This method will fail in several very likely cases:
533 # - Parser modules in different namespaces
535 # - Parser modules in the SQL::Translator::Parser namespace that
536 # have any XS componenets will be installed in
537 # arch_lib/SQL/Translator.
539 # ----------------------------------------------------------------------
541 return shift->_list("parser");
544 # ----------------------------------------------------------------------
547 # See notes for list_parsers(), above; all the problems apply to
548 # list_producers as well.
549 # ----------------------------------------------------------------------
551 return shift->_list("producer");
555 # ======================================================================
557 # ======================================================================
559 # ----------------------------------------------------------------------
560 # _args($type, \%args);
562 # Gets or sets ${type}_args. Called by parser_args and producer_args.
563 # ----------------------------------------------------------------------
567 $type = "${type}_args" unless $type =~ /_args$/;
569 unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
570 $self->{$type} = { };
574 # If the first argument is an explicit undef (remember, we
575 # don't get here unless there is stuff in @_), then we clear
576 # out the producer_args hash.
577 if (! defined $_[0]) {
579 %{$self->{$type}} = ();
582 my $args = isa($_[0], 'HASH') ? shift : { @_ };
583 %{$self->{$type}} = (%{$self->{$type}}, %$args);
589 # ----------------------------------------------------------------------
590 # Does the get/set work for parser and producer. e.g.
591 # return $self->_tool({
592 # name => 'producer',
593 # path => "SQL::Translator::Producer",
594 # default_sub => "produce",
596 # ----------------------------------------------------------------------
598 my ($self,$args) = (shift, shift);
599 my $name = $args->{name};
600 return $self->{$name} unless @_; # get accessor
602 my $path = $args->{path};
603 my $default_sub = $args->{default_sub};
606 # passed an anonymous subroutine reference
607 if (isa($tool, 'CODE')) {
608 $self->{$name} = $tool;
609 $self->{"$name\_type"} = "CODE";
610 $self->debug("Got $name: code ref\n");
613 # Module name was passed directly
614 # We try to load the name; if it doesn't load, there's a
615 # possibility that it has a function name attached to it,
616 # so we give it a go.
618 $tool =~ s/-/::/g if $tool !~ /::/;
620 ($code,$sub) = _load_sub("$tool\::$default_sub", $path);
622 if ( __PACKAGE__->error =~ m/Can't find module/ ) {
623 # Mod not found so try sub
624 ($code,$sub) = _load_sub("$tool", $path) unless $code;
625 die "Can't load $name subroutine '$tool' : ".__PACKAGE__->error
629 die "Can't load $name '$tool' : ".__PACKAGE__->error;
633 # get code reference and assign
634 my (undef,$module,undef) = $sub =~ m/((.*)::)?(\w+)$/;
635 $self->{$name} = $code;
636 $self->{"$name\_type"} = $sub eq "CODE" ? "CODE" : $module;
637 $self->debug("Got $name: $sub\n");
640 # At this point, $self->{$name} contains a subroutine
641 # reference that is ready to run
643 # Anything left? If so, it's args
644 my $meth = "$name\_args";
645 $self->$meth(@_) if (@_);
647 return $self->{$name};
650 # ----------------------------------------------------------------------
652 # ----------------------------------------------------------------------
655 my $type = shift || return ();
656 my $uctype = ucfirst lc $type;
659 # First find all the directories where SQL::Translator
660 # parsers or producers (the "type") appear to live.
662 load("SQL::Translator::$uctype") or return ();
663 my $path = catfile "SQL", "Translator", $uctype;
666 my $dir = catfile $_, $path;
667 $self->debug("_list_${type}s searching $dir\n");
673 # Now use File::File::find to look recursively in those
674 # directories for all the *.pm files, then present them
675 # with the slashes turned into dashes.
680 if ( -f && m/\.pm$/ ) {
683 my $cur_dir = $File::Find::dir;
684 my $base_dir = quotemeta catfile 'SQL', 'Translator', $uctype;
687 # See if the current directory is below the base directory.
689 if ( $cur_dir =~ m/$base_dir(.*)/ ) {
691 $cur_dir =~ s!^/!!; # kill leading slash
692 $cur_dir =~ s!/!-!g; # turn other slashes into dashes
698 $found{ join '-', map { $_ || () } $cur_dir, $mod } = 1;
704 return sort { lc $a cmp lc $b } keys %found;
707 # ----------------------------------------------------------------------
708 # load(MODULE [,PATH[,PATH]...])
710 # Loads a Perl module. Short circuits if a module is already loaded.
712 # MODULE - is the name of the module to load.
714 # PATH - optional list of 'package paths' to look for the module in. e.g
715 # If you called load('Super::Foo' => 'My', 'Other') it will
716 # try to load the mod Super::Foo then My::Super::Foo then Other::Super::Foo.
718 # Returns package name of the module actually loaded or false and sets error.
720 # Note, you can't load a name from the root namespace (ie one without '::' in
721 # it), therefore a single word name without a path fails.
722 # ----------------------------------------------------------------------
726 push @path, "" if $name =~ /::/; # Empty path to check name on its own first
727 push @path, @_ if @_;
730 my $module = $_ ? "$_\::$name" : $name;
731 my $file = $module; $file =~ s[::][/]g; $file .= ".pm";
732 __PACKAGE__->debug("Loading $name as $file\n");
733 return $module if $INC{$file}; # Already loaded
735 eval { require $file };
736 next if $@ =~ /Can't locate $file in \@INC/;
737 eval { $module->import() } unless $@;
738 return __PACKAGE__->error("Error loading $name as $module : $@")
739 if $@ && $@ !~ /"SQL::Translator::Producer" is not exported/;
741 return $module; # Module loaded ok
744 return __PACKAGE__->error("Can't find module $name. Path:".join(",",@path));
747 # ----------------------------------------------------------------------
748 # Load the sub name given (including package), optionally using a base package
749 # path. Returns code ref and name of sub loaded, including its package.
750 # (\&code, $sub) = load_sub( 'MySQL::produce', "SQL::Translator::Producer" );
751 # (\&code, $sub) = load_sub( 'MySQL::produce', @path );
752 # ----------------------------------------------------------------------
754 my ($tool, @path) = @_;
756 my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/;
757 if ( my $module = load($module => @path) ) {
758 my $sub = "$module\::$func_name";
759 return wantarray ? ( \&{ $sub }, $sub ) : \&$sub;
764 # ----------------------------------------------------------------------
765 sub format_table_name {
766 return shift->_format_name('_format_table_name', @_);
769 # ----------------------------------------------------------------------
770 sub format_package_name {
771 return shift->_format_name('_format_package_name', @_);
774 # ----------------------------------------------------------------------
776 return shift->_format_name('_format_fk_name', @_);
779 # ----------------------------------------------------------------------
781 return shift->_format_name('_format_pk_name', @_);
784 # ----------------------------------------------------------------------
785 # The other format_*_name methods rely on this one. It optionally
786 # accepts a subroutine ref as the first argument (or uses an identity
787 # sub if one isn't provided or it doesn't already exist), and applies
788 # it to the rest of the arguments (if any).
789 # ----------------------------------------------------------------------
795 if (ref($args[0]) eq 'CODE') {
796 $self->{$field} = shift @args;
798 elsif (! exists $self->{$field}) {
799 $self->{$field} = sub { return shift };
802 return @args ? $self->{$field}->(@args) : $self->{$field};
805 # ----------------------------------------------------------------------
808 # Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
809 # but I like function overhead.
810 # ----------------------------------------------------------------------
812 my ($ref, $type) = @_;
813 return UNIVERSAL::isa($ref, $type);
816 # ----------------------------------------------------------------------
819 # Returns the $VERSION of the main SQL::Translator package.
820 # ----------------------------------------------------------------------
826 # ----------------------------------------------------------------------
828 my ( $self, $arg ) = @_;
829 if ( defined $arg ) {
830 $self->{'validate'} = $arg ? 1 : 0;
832 return $self->{'validate'} || 0;
837 # ----------------------------------------------------------------------
838 # Who killed the pork chops?
839 # What price bananas?
842 # ----------------------------------------------------------------------
848 SQL::Translator - manipulate structured data definitions (SQL and more)
854 my $translator = SQL::Translator->new(
857 # Print Parse::RecDescent trace
859 # Don't include comments in output
861 # Print name mutations, conflicts
863 # Add "drop table" statements
865 # Validate schema object
867 # Make all table names CAPS in producers which support this option
868 format_table_name => sub {my $tablename = shift; return uc($tablename)},
869 # Null-op formatting, only here for documentation's sake
870 format_package_name => sub {return shift},
871 format_fk_name => sub {return shift},
872 format_pk_name => sub {return shift},
875 my $output = $translator->translate(
878 # Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
880 ) or die $translator->error;
886 This documentation covers the API for SQL::Translator. For a more general
887 discussion of how to use the modules and scripts, please see
888 L<SQL::Translator::Manual>.
890 SQL::Translator is a group of Perl modules that converts
891 vendor-specific SQL table definitions into other formats, such as
892 other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
893 XML, and Class::DBI classes. The main focus of SQL::Translator is
894 SQL, but parsers exist for other structured data formats, including
895 Excel spreadsheets and arbitrarily delimited text files. Through the
896 separation of the code into parsers and producers with an object model
897 in between, it's possible to combine any parser with any producer, to
898 plug in custom parsers or producers, or to manipulate the parsed data
899 via the built-in object model. Presently only the definition parts of
900 SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
905 The constructor is called C<new>, and accepts a optional hash of options.
960 All options are, well, optional; these attributes can be set via
961 instance methods. Internally, they are; no (non-syntactical)
962 advantage is gained by passing options to the constructor.
966 =head2 add_drop_table
968 Toggles whether or not to add "DROP TABLE" statements just before the
973 Toggles whether to print comments in the output. Accepts a true or false
974 value, returns the current value.
978 The C<producer> method is an accessor/mutator, used to retrieve or
979 define what subroutine is called to produce the output. A subroutine
980 defined as a producer will be invoked as a function (I<not a method>)
981 and passed its container C<SQL::Translator> instance, which it should
982 call the C<schema> method on, to get the C<SQL::Translator::Schema>
983 generated by the parser. It is expected that the function transform the
984 schema structure to a string. The C<SQL::Translator> instance is also useful
985 for informational purposes; for example, the type of the parser can be
986 retrieved using the C<parser_type> method, and the C<error> and
987 C<debug> methods can be called when needed.
989 When defining a producer, one of several things can be passed in: A
990 module name (e.g., C<My::Groovy::Producer>), a module name relative to
991 the C<SQL::Translator::Producer> namespace (e.g., C<MySQL>), a module
992 name and function combination (C<My::Groovy::Producer::transmogrify>),
993 or a reference to an anonymous subroutine. If a full module name is
994 passed in (for the purposes of this method, a string containing "::"
995 is considered to be a module name), it is treated as a package, and a
996 function called "produce" will be invoked: C<$modulename::produce>.
997 If $modulename cannot be loaded, the final portion is stripped off and
998 treated as a function. In other words, if there is no file named
999 F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
1000 to load F<My/Groovy/Producer.pm> and use C<transmogrify> as the name of
1001 the function, instead of the default C<produce>.
1003 my $tr = SQL::Translator->new;
1005 # This will invoke My::Groovy::Producer::produce($tr, $data)
1006 $tr->producer("My::Groovy::Producer");
1008 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
1009 $tr->producer("Sybase");
1011 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
1012 # assuming that My::Groovy::Producer::transmogrify is not a module
1014 $tr->producer("My::Groovy::Producer::transmogrify");
1016 # This will invoke the referenced subroutine directly, as
1017 # $subref->($tr, $data);
1018 $tr->producer(\&my_producer);
1020 There is also a method named C<producer_type>, which is a string
1021 containing the classname to which the above C<produce> function
1022 belongs. In the case of anonymous subroutines, this method returns
1025 Finally, there is a method named C<producer_args>, which is both an
1026 accessor and a mutator. Arbitrary data may be stored in name => value
1027 pairs for the producer subroutine to access:
1029 sub My::Random::producer {
1030 my ($tr, $data) = @_;
1031 my $pr_args = $tr->producer_args();
1033 # $pr_args is a hashref.
1035 Extra data passed to the C<producer> method is passed to
1038 $tr->producer("xSV", delimiter => ',\s*');
1040 # In SQL::Translator::Producer::xSV:
1041 my $args = $tr->producer_args;
1042 my $delimiter = $args->{'delimiter'}; # value is ,\s*
1046 The C<parser> method defines or retrieves a subroutine that will be
1047 called to perform the parsing. The basic idea is the same as that of
1048 C<producer> (see above), except the default subroutine name is
1049 "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
1050 Also, the parser subroutine will be passed a string containing the
1051 entirety of the data to be parsed.
1053 # Invokes SQL::Translator::Parser::MySQL::parse()
1054 $tr->parser("MySQL");
1056 # Invokes My::Groovy::Parser::parse()
1057 $tr->parser("My::Groovy::Parser");
1059 # Invoke an anonymous subroutine directly
1061 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
1062 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
1063 return $dumper->Dump;
1066 There is also C<parser_type> and C<parser_args>, which perform
1067 analogously to C<producer_type> and C<producer_args>
1071 Set or retreive the filters to run over the schema during the
1072 translation, before the producer creates its output. Filters are sub
1073 routines called, in order, with the schema object to filter as the 1st
1074 arg and a hash of options (passed as a list) for the rest of the args.
1075 They are free to do whatever they want to the schema object, which will be
1076 handed to any following filters, then used by the producer.
1078 Filters are set as an array, which gives the order they run in.
1079 Like parsers and producers, they can be defined by a module name, a
1080 module name relative to the SQL::Translator::Filter namespace, a module
1081 name and function name together or a reference to an anonymous subroutine.
1082 When using a module name a function called C<filter> will be invoked in
1083 that package to do the work.
1085 To pass args to the filter set it as an array ref with the 1st value giving
1086 the filter (name or sub) and the rest its args. e.g.
1091 # Do stuff to schema here!
1094 [ "Names", table => 'lc' ],
1095 [ "Foo", foo => "bar", hello => "world" ],
1099 Although you normally set them in the constructor, which calls
1100 through to filters. i.e.
1102 my $translator = SQL::Translator->new(
1106 [ "Names", table => 'lc' ],
1111 See F<t/36-filters.t> for more examples.
1113 Multiple set calls to filters are cumulative with new filters added to
1114 the end of the current list.
1116 Returns the filters as a list of array refs, the 1st value being a
1117 reference to the filter sub and the rest its args.
1119 =head2 show_warnings
1121 Toggles whether to print warnings of name conflicts, identifier
1122 mutations, etc. Probably only generated by producers to let the user
1123 know when something won't translate very smoothly (e.g., MySQL "enum"
1124 fields into Oracle). Accepts a true or false value, returns the
1129 The C<translate> method calls the subroutine referenced by the
1130 C<parser> data member, then calls any C<filters> and finally calls
1131 the C<producer> sub routine (these members are described above).
1132 It accepts as arguments a number of things, in key => value format,
1133 including (potentially) a parser and a producer (they are passed
1134 directly to the C<parser> and C<producer> methods).
1136 Here is how the parameter list to C<translate> is parsed:
1142 1 argument means it's the data to be parsed; which could be a string
1143 (filename) or a reference to a scalar (a string stored in memory), or a
1144 reference to a hash, which is parsed as being more than one argument
1147 # Parse the file /path/to/datafile
1148 my $output = $tr->translate("/path/to/datafile");
1150 # Parse the data contained in the string $data
1151 my $output = $tr->translate(\$data);
1155 More than 1 argument means its a hash of things, and it might be
1156 setting a parser, producer, or datasource (this key is named
1157 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
1159 # As above, parse /path/to/datafile, but with different producers
1160 for my $prod ("MySQL", "XML", "Sybase") {
1161 print $tr->translate(
1163 filename => "/path/to/datafile",
1167 # The filename hash key could also be:
1168 datasource => \$data,
1174 =head2 filename, data
1176 Using the C<filename> method, the filename of the data to be parsed
1177 can be set. This method can be used in conjunction with the C<data>
1178 method, below. If both the C<filename> and C<data> methods are
1179 invoked as mutators, the data set in the C<data> method is used.
1181 $tr->filename("/my/data/files/create.sql");
1185 my $create_script = do {
1187 open CREATE, "/my/data/files/create.sql" or die $!;
1190 $tr->data(\$create_script);
1192 C<filename> takes a string, which is interpreted as a filename.
1193 C<data> takes a reference to a string, which is used as the data to be
1194 parsed. If a filename is set, then that file is opened and read when
1195 the C<translate> method is called, as long as the data instance
1196 variable is not set.
1200 Returns the SQL::Translator::Schema object.
1204 Turns on/off the tracing option of Parse::RecDescent.
1208 Whether or not to validate the schema object after parsing and before
1213 Returns the version of the SQL::Translator release.
1217 The following people have contributed to the SQLFairy project:
1221 =item * Mark Addison <grommit@users.sourceforge.net>
1223 =item * Sam Angiuoli <angiuoli@users.sourceforge.net>
1225 =item * Dave Cash <dave@gnofn.org>
1227 =item * Darren Chamberlain <dlc@users.sourceforge.net>
1229 =item * Ken Y. Clark <kclark@cpan.org>
1231 =item * Allen Day <allenday@users.sourceforge.net>
1233 =item * Paul Harrington <phrrngtn@users.sourceforge.net>
1235 =item * Mikey Melillo <mmelillo@users.sourceforge.net>
1237 =item * Chris Mungall <cjm@fruitfly.org>
1239 =item * Ross Smith II <rossta@users.sf.net>
1241 =item * Gudmundur A. Thorisson <mummi@cshl.org>
1243 =item * Chris To <christot@users.sourceforge.net>
1245 =item * Jason Williams <smdwilliams@users.sourceforge.net>
1247 =item * Ying Zhang <zyolive@yahoo.com>
1251 If you would like to contribute to the project, you can send patches
1252 to the developers mailing list:
1254 sqlfairy-developers@lists.sourceforge.net
1256 Or send us a message (with your Sourceforge username) asking to be
1257 added to the project and what you'd like to contribute.
1262 This program is free software; you can redistribute it and/or modify
1263 it under the terms of the GNU General Public License as published by
1264 the Free Software Foundation; version 2.
1266 This program is distributed in the hope that it will be useful, but
1267 WITHOUT ANY WARRANTY; without even the implied warranty of
1268 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1269 General Public License for more details.
1271 You should have received a copy of the GNU General Public License
1272 along with this program; if not, write to the Free Software
1273 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
1278 Please use L<http://rt.cpan.org/> for reporting bugs.
1282 If you find this module useful, please use
1283 L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
1288 L<SQL::Translator::Parser>,
1289 L<SQL::Translator::Producer>,
1290 L<Parse::RecDescent>,
1293 L<Text::RecordParser>,