1 package SQL::Translator;
3 # ----------------------------------------------------------------------
4 # $Id: Translator.pm,v 1.73 2007-10-24 10:55:45 schiffbruechige 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.73 $ =~ /(\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'} );
129 $self->quote_table_names( (defined $config->{'quote_table_names'}
130 ? $config->{'quote_table_names'} : 1) );
131 $self->quote_field_names( (defined $config->{'quote_field_names'}
132 ? $config->{'quote_field_names'} : 1) );
137 # ----------------------------------------------------------------------
138 # add_drop_table([$bool])
139 # ----------------------------------------------------------------------
142 if ( defined (my $arg = shift) ) {
143 $self->{'add_drop_table'} = $arg ? 1 : 0;
145 return $self->{'add_drop_table'} || 0;
148 # ----------------------------------------------------------------------
149 # no_comments([$bool])
150 # ----------------------------------------------------------------------
154 if ( defined $arg ) {
155 $self->{'no_comments'} = $arg ? 1 : 0;
157 return $self->{'no_comments'} || 0;
161 # ----------------------------------------------------------------------
162 # quote_table_names([$bool])
163 # ----------------------------------------------------------------------
164 sub quote_table_names {
166 if ( defined (my $arg = shift) ) {
167 $self->{'quote_table_names'} = $arg ? 1 : 0;
169 return $self->{'quote_table_names'} || 0;
172 # ----------------------------------------------------------------------
173 # quote_field_names([$bool])
174 # ----------------------------------------------------------------------
175 sub quote_field_names {
177 if ( defined (my $arg = shift) ) {
178 $self->{'quote_field_names'} = $arg ? 1 : 0;
180 return $self->{'quote_field_names'} || 0;
183 # ----------------------------------------------------------------------
184 # producer([$producer_spec])
186 # Get or set the producer for the current translator.
187 # ----------------------------------------------------------------------
191 path => "SQL::Translator::Producer",
192 default_sub => "produce",
196 # ----------------------------------------------------------------------
199 # producer_type is an accessor that allows producer subs to get
200 # information about their origin. This is poptentially important;
201 # since all producer subs are called as subroutine references, there is
202 # no way for a producer to find out which package the sub lives in
203 # originally, for example.
204 # ----------------------------------------------------------------------
205 sub producer_type { $_[0]->{'producer_type'} }
207 # ----------------------------------------------------------------------
208 # producer_args([\%args])
210 # Arbitrary name => value pairs of paramters can be passed to a
211 # producer using this method.
213 # If the first argument passed in is undef, then the hash of arguments
214 # is cleared; all subsequent elements are added to the hash of name,
215 # value pairs stored as producer_args.
216 # ----------------------------------------------------------------------
217 sub producer_args { shift->_args("producer", @_); }
219 # ----------------------------------------------------------------------
220 # parser([$parser_spec])
221 # ----------------------------------------------------------------------
225 path => "SQL::Translator::Parser",
226 default_sub => "parse",
230 sub parser_type { $_[0]->{'parser_type'}; }
232 sub parser_args { shift->_args("parser", @_); }
234 # ----------------------------------------------------------------------
236 # $sqlt->filters => [
238 # [ "NormalizeNames", field => "lc", tabel => "ucfirst" ],
241 # "TEXT" => "BIGTEXT",
244 # ----------------------------------------------------------------------
247 my $filters = $self->{filters} ||= [];
248 return @$filters unless @_;
250 # Set. Convert args to list of [\&code,@args]
252 my ($filt,@args) = ref($_) eq "ARRAY" ? @$_ : $_;
253 if ( isa($filt,"CODE") ) {
254 push @$filters, [$filt,@args];
258 $self->debug("Adding $filt filter. Args:".Dumper(\@args)."\n");
259 $filt = _load_sub("$filt\::filter", "SQL::Translator::Filter")
260 || return $self->error(__PACKAGE__->error);
261 push @$filters, [$filt,@args];
267 # ----------------------------------------------------------------------
271 if ( defined $arg ) {
272 $self->{'show_warnings'} = $arg ? 1 : 0;
274 return $self->{'show_warnings'} || 0;
278 # filename - get or set the filename
282 my $filename = shift;
284 my $msg = "Cannot use directory '$filename' as input source";
285 return $self->error($msg);
286 } elsif (ref($filename) eq 'ARRAY') {
287 $self->{'filename'} = $filename;
288 $self->debug("Got array of files: ".join(', ',@$filename)."\n");
289 } elsif (-f _ && -r _) {
290 $self->{'filename'} = $filename;
291 $self->debug("Got filename: '$self->{'filename'}'\n");
293 my $msg = "Cannot use '$filename' as input source: ".
294 "file does not exist or is not readable.";
295 return $self->error($msg);
302 # ----------------------------------------------------------------------
305 # if $self->{'data'} is not set, but $self->{'filename'} is, then
306 # $self->{'filename'} is opened and read, with the results put into
308 # ----------------------------------------------------------------------
312 # Set $self->{'data'} based on what was passed in. We will
313 # accept a number of things; do our best to get it right.
316 if (isa($data, "SCALAR")) {
317 $self->{'data'} = $data;
320 if (isa($data, 'ARRAY')) {
321 $data = join '', @$data;
323 elsif (isa($data, 'GLOB')) {
327 elsif (! ref $data && @_) {
328 $data = join '', $data, @_;
330 $self->{'data'} = \$data;
334 # If we have a filename but no data yet, populate.
335 if (not $self->{'data'} and my $filename = $self->filename) {
336 $self->debug("Opening '$filename' to get contents.\n");
341 my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
343 foreach my $file (@files) {
344 unless (open FH, $file) {
345 return $self->error("Can't read file '$file': $!");
351 return $self->error("Can't close file '$file': $!");
355 $self->{'data'} = \$data;
358 return $self->{'data'};
361 # ----------------------------------------------------------------------
364 # Deletes the existing Schema object so that future calls to translate
365 # don't append to the existing.
368 $self->{'schema'} = undef;
372 # ----------------------------------------------------------------------
375 # Returns the SQL::Translator::Schema object
379 unless ( defined $self->{'schema'} ) {
380 $self->{'schema'} = SQL::Translator::Schema->new(
385 return $self->{'schema'};
388 # ----------------------------------------------------------------------
392 if ( defined $arg ) {
393 $self->{'trace'} = $arg ? 1 : 0;
395 return $self->{'trace'} || 0;
398 # ----------------------------------------------------------------------
399 # translate([source], [\%args])
401 # translate does the actual translation. The main argument is the
402 # source of the data to be translated, which can be a filename, scalar
403 # reference, or glob reference.
405 # Alternatively, translate takes optional arguements, which are passed
406 # to the appropriate places. Most notable of these arguments are
407 # parser and producer, which can be used to set the parser and
408 # producer, respectively. This is the applications last chance to set
411 # translate returns a string.
412 # ----------------------------------------------------------------------
415 my ($args, $parser, $parser_type, $producer, $producer_type);
416 my ($parser_output, $producer_output, @producer_output);
420 # Passed a reference to a hash?
421 if (isa($_[0], 'HASH')) {
423 $self->debug("translate: Got a hashref\n");
427 # Passed a GLOB reference, i.e., filehandle
428 elsif (isa($_[0], 'GLOB')) {
429 $self->debug("translate: Got a GLOB reference\n");
433 # Passed a reference to a string containing the data
434 elsif (isa($_[0], 'SCALAR')) {
435 # passed a ref to a string
436 $self->debug("translate: Got a SCALAR reference (string)\n");
440 # Not a reference; treat it as a filename
441 elsif (! ref $_[0]) {
442 # Not a ref, it's a filename
443 $self->debug("translate: Got a filename\n");
444 $self->filename($_[0]);
447 # Passed something else entirely.
449 # We're not impressed. Take your empty string and leave.
452 # Actually, if data, parser, and producer are set, then we
453 # can continue. Too bad, because I like my comment
455 return "" unless ($self->data &&
461 # You must pass in a hash, or you get nothing.
466 # ----------------------------------------------------------------------
467 # Can specify the data to be transformed using "filename", "file",
468 # "data", or "datasource".
469 # ----------------------------------------------------------------------
470 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
471 $self->filename($filename);
474 if (my $data = ($args->{'data'} || $args->{'datasource'})) {
478 # ----------------------------------------------------------------
480 # ----------------------------------------------------------------
481 my $data = $self->data;
483 # ----------------------------------------------------------------
484 # Local reference to the parser subroutine
485 # ----------------------------------------------------------------
486 if ($parser = ($args->{'parser'} || $args->{'from'})) {
487 $self->parser($parser);
489 $parser = $self->parser;
490 $parser_type = $self->parser_type;
492 # ----------------------------------------------------------------
493 # Local reference to the producer subroutine
494 # ----------------------------------------------------------------
495 if ($producer = ($args->{'producer'} || $args->{'to'})) {
496 $self->producer($producer);
498 $producer = $self->producer;
499 $producer_type = $self->producer_type;
501 # ----------------------------------------------------------------
502 # Execute the parser, the filters and then execute the producer.
503 # Allowances are made for each piece to die, or fail to compile,
504 # since the referenced subroutines could be almost anything. In
505 # the future, each of these might happen in a Safe environment,
506 # depending on how paranoid we want to be.
507 # ----------------------------------------------------------------
510 unless ( defined $self->{'schema'} ) {
511 eval { $parser_output = $parser->($self, $$data) };
512 if ($@ || ! $parser_output) {
513 my $msg = sprintf "translate: Error with parser '%s': %s",
514 $parser_type, ($@) ? $@ : " no results";
515 return $self->error($msg);
518 $self->debug("Schema =\n", Dumper($self->schema), "\n");
520 # Validate the schema if asked to.
521 if ($self->validate) {
522 my $schema = $self->schema;
523 return $self->error('Invalid schema') unless $schema->is_valid;
528 foreach ($self->filters) {
530 my ($code,@args) = @$_;
531 eval { $code->($self->schema, @args) };
532 my $err = $@ || $self->error || 0;
533 return $self->error("Error with filter $filt_num : $err") if $err;
537 # Calling wantarray in the eval no work, wrong scope.
538 my $wantarray = wantarray ? 1 : 0;
541 @producer_output = $producer->($self);
543 $producer_output = $producer->($self);
546 if ($@ || !( $producer_output || @producer_output)) {
547 my $err = $@ || $self->error || "no results";
548 my $msg = "translate: Error with producer '$producer_type': $err";
549 return $self->error($msg);
552 return wantarray ? @producer_output : $producer_output;
555 # ----------------------------------------------------------------------
558 # Hacky sort of method to list all available parsers. This has
561 # - Only finds things in the SQL::Translator::Parser namespace
563 # - Only finds things that are located in the same directory
564 # as SQL::Translator::Parser. Yeck.
566 # This method will fail in several very likely cases:
568 # - Parser modules in different namespaces
570 # - Parser modules in the SQL::Translator::Parser namespace that
571 # have any XS componenets will be installed in
572 # arch_lib/SQL/Translator.
574 # ----------------------------------------------------------------------
576 return shift->_list("parser");
579 # ----------------------------------------------------------------------
582 # See notes for list_parsers(), above; all the problems apply to
583 # list_producers as well.
584 # ----------------------------------------------------------------------
586 return shift->_list("producer");
590 # ======================================================================
592 # ======================================================================
594 # ----------------------------------------------------------------------
595 # _args($type, \%args);
597 # Gets or sets ${type}_args. Called by parser_args and producer_args.
598 # ----------------------------------------------------------------------
602 $type = "${type}_args" unless $type =~ /_args$/;
604 unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
605 $self->{$type} = { };
609 # If the first argument is an explicit undef (remember, we
610 # don't get here unless there is stuff in @_), then we clear
611 # out the producer_args hash.
612 if (! defined $_[0]) {
614 %{$self->{$type}} = ();
617 my $args = isa($_[0], 'HASH') ? shift : { @_ };
618 %{$self->{$type}} = (%{$self->{$type}}, %$args);
624 # ----------------------------------------------------------------------
625 # Does the get/set work for parser and producer. e.g.
626 # return $self->_tool({
627 # name => 'producer',
628 # path => "SQL::Translator::Producer",
629 # default_sub => "produce",
631 # ----------------------------------------------------------------------
633 my ($self,$args) = (shift, shift);
634 my $name = $args->{name};
635 return $self->{$name} unless @_; # get accessor
637 my $path = $args->{path};
638 my $default_sub = $args->{default_sub};
641 # passed an anonymous subroutine reference
642 if (isa($tool, 'CODE')) {
643 $self->{$name} = $tool;
644 $self->{"$name\_type"} = "CODE";
645 $self->debug("Got $name: code ref\n");
648 # Module name was passed directly
649 # We try to load the name; if it doesn't load, there's a
650 # possibility that it has a function name attached to it,
651 # so we give it a go.
653 $tool =~ s/-/::/g if $tool !~ /::/;
655 ($code,$sub) = _load_sub("$tool\::$default_sub", $path);
657 if ( __PACKAGE__->error =~ m/Can't find module/ ) {
658 # Mod not found so try sub
659 ($code,$sub) = _load_sub("$tool", $path) unless $code;
660 die "Can't load $name subroutine '$tool' : ".__PACKAGE__->error
664 die "Can't load $name '$tool' : ".__PACKAGE__->error;
668 # get code reference and assign
669 my (undef,$module,undef) = $sub =~ m/((.*)::)?(\w+)$/;
670 $self->{$name} = $code;
671 $self->{"$name\_type"} = $sub eq "CODE" ? "CODE" : $module;
672 $self->debug("Got $name: $sub\n");
675 # At this point, $self->{$name} contains a subroutine
676 # reference that is ready to run
678 # Anything left? If so, it's args
679 my $meth = "$name\_args";
680 $self->$meth(@_) if (@_);
682 return $self->{$name};
685 # ----------------------------------------------------------------------
687 # ----------------------------------------------------------------------
690 my $type = shift || return ();
691 my $uctype = ucfirst lc $type;
694 # First find all the directories where SQL::Translator
695 # parsers or producers (the "type") appear to live.
697 load("SQL::Translator::$uctype") or return ();
698 my $path = catfile "SQL", "Translator", $uctype;
701 my $dir = catfile $_, $path;
702 $self->debug("_list_${type}s searching $dir\n");
708 # Now use File::File::find to look recursively in those
709 # directories for all the *.pm files, then present them
710 # with the slashes turned into dashes.
715 if ( -f && m/\.pm$/ ) {
718 my $cur_dir = $File::Find::dir;
719 my $base_dir = quotemeta catfile 'SQL', 'Translator', $uctype;
722 # See if the current directory is below the base directory.
724 if ( $cur_dir =~ m/$base_dir(.*)/ ) {
726 $cur_dir =~ s!^/!!; # kill leading slash
727 $cur_dir =~ s!/!-!g; # turn other slashes into dashes
733 $found{ join '-', map { $_ || () } $cur_dir, $mod } = 1;
739 return sort { lc $a cmp lc $b } keys %found;
742 # ----------------------------------------------------------------------
743 # load(MODULE [,PATH[,PATH]...])
745 # Loads a Perl module. Short circuits if a module is already loaded.
747 # MODULE - is the name of the module to load.
749 # PATH - optional list of 'package paths' to look for the module in. e.g
750 # If you called load('Super::Foo' => 'My', 'Other') it will
751 # try to load the mod Super::Foo then My::Super::Foo then Other::Super::Foo.
753 # Returns package name of the module actually loaded or false and sets error.
755 # Note, you can't load a name from the root namespace (ie one without '::' in
756 # it), therefore a single word name without a path fails.
757 # ----------------------------------------------------------------------
761 push @path, "" if $name =~ /::/; # Empty path to check name on its own first
762 push @path, @_ if @_;
765 my $module = $_ ? "$_\::$name" : $name;
766 my $file = $module; $file =~ s[::][/]g; $file .= ".pm";
767 __PACKAGE__->debug("Loading $name as $file\n");
768 return $module if $INC{$file}; # Already loaded
770 eval { require $file };
771 next if $@ =~ /Can't locate $file in \@INC/;
772 eval { $module->import() } unless $@;
773 return __PACKAGE__->error("Error loading $name as $module : $@")
774 if $@ && $@ !~ /"SQL::Translator::Producer" is not exported/;
776 return $module; # Module loaded ok
779 return __PACKAGE__->error("Can't find module $name. Path:".join(",",@path));
782 # ----------------------------------------------------------------------
783 # Load the sub name given (including package), optionally using a base package
784 # path. Returns code ref and name of sub loaded, including its package.
785 # (\&code, $sub) = load_sub( 'MySQL::produce', "SQL::Translator::Producer" );
786 # (\&code, $sub) = load_sub( 'MySQL::produce', @path );
787 # ----------------------------------------------------------------------
789 my ($tool, @path) = @_;
791 my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/;
792 if ( my $module = load($module => @path) ) {
793 my $sub = "$module\::$func_name";
794 return wantarray ? ( \&{ $sub }, $sub ) : \&$sub;
799 # ----------------------------------------------------------------------
800 sub format_table_name {
801 return shift->_format_name('_format_table_name', @_);
804 # ----------------------------------------------------------------------
805 sub format_package_name {
806 return shift->_format_name('_format_package_name', @_);
809 # ----------------------------------------------------------------------
811 return shift->_format_name('_format_fk_name', @_);
814 # ----------------------------------------------------------------------
816 return shift->_format_name('_format_pk_name', @_);
819 # ----------------------------------------------------------------------
820 # The other format_*_name methods rely on this one. It optionally
821 # accepts a subroutine ref as the first argument (or uses an identity
822 # sub if one isn't provided or it doesn't already exist), and applies
823 # it to the rest of the arguments (if any).
824 # ----------------------------------------------------------------------
830 if (ref($args[0]) eq 'CODE') {
831 $self->{$field} = shift @args;
833 elsif (! exists $self->{$field}) {
834 $self->{$field} = sub { return shift };
837 return @args ? $self->{$field}->(@args) : $self->{$field};
840 # ----------------------------------------------------------------------
843 # Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
844 # but I like function overhead.
845 # ----------------------------------------------------------------------
847 my ($ref, $type) = @_;
848 return UNIVERSAL::isa($ref, $type);
851 # ----------------------------------------------------------------------
854 # Returns the $VERSION of the main SQL::Translator package.
855 # ----------------------------------------------------------------------
861 # ----------------------------------------------------------------------
863 my ( $self, $arg ) = @_;
864 if ( defined $arg ) {
865 $self->{'validate'} = $arg ? 1 : 0;
867 return $self->{'validate'} || 0;
872 # ----------------------------------------------------------------------
873 # Who killed the pork chops?
874 # What price bananas?
877 # ----------------------------------------------------------------------
883 SQL::Translator - manipulate structured data definitions (SQL and more)
889 my $translator = SQL::Translator->new(
892 # Print Parse::RecDescent trace
894 # Don't include comments in output
896 # Print name mutations, conflicts
898 # Add "drop table" statements
900 # to quote or not to quote, thats the question
901 quote_table_names => 1,
902 quote_field_names => 1,
903 # Validate schema object
905 # Make all table names CAPS in producers which support this option
906 format_table_name => sub {my $tablename = shift; return uc($tablename)},
907 # Null-op formatting, only here for documentation's sake
908 format_package_name => sub {return shift},
909 format_fk_name => sub {return shift},
910 format_pk_name => sub {return shift},
913 my $output = $translator->translate(
916 # Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
918 ) or die $translator->error;
924 This documentation covers the API for SQL::Translator. For a more general
925 discussion of how to use the modules and scripts, please see
926 L<SQL::Translator::Manual>.
928 SQL::Translator is a group of Perl modules that converts
929 vendor-specific SQL table definitions into other formats, such as
930 other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
931 XML, and Class::DBI classes. The main focus of SQL::Translator is
932 SQL, but parsers exist for other structured data formats, including
933 Excel spreadsheets and arbitrarily delimited text files. Through the
934 separation of the code into parsers and producers with an object model
935 in between, it's possible to combine any parser with any producer, to
936 plug in custom parsers or producers, or to manipulate the parsed data
937 via the built-in object model. Presently only the definition parts of
938 SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
943 The constructor is called C<new>, and accepts a optional hash of options.
1006 All options are, well, optional; these attributes can be set via
1007 instance methods. Internally, they are; no (non-syntactical)
1008 advantage is gained by passing options to the constructor.
1012 =head2 add_drop_table
1014 Toggles whether or not to add "DROP TABLE" statements just before the
1017 =head2 quote_table_names
1019 Toggles whether or not to quote table names with " in DROP and CREATE
1020 statements. The default (true) is to quote them.
1022 =head2 quote_field_names
1024 Toggles whether or not to quote field names with " in most
1025 statements. The default (true), is to quote them.
1029 Toggles whether to print comments in the output. Accepts a true or false
1030 value, returns the current value.
1034 The C<producer> method is an accessor/mutator, used to retrieve or
1035 define what subroutine is called to produce the output. A subroutine
1036 defined as a producer will be invoked as a function (I<not a method>)
1037 and passed its container C<SQL::Translator> instance, which it should
1038 call the C<schema> method on, to get the C<SQL::Translator::Schema>
1039 generated by the parser. It is expected that the function transform the
1040 schema structure to a string. The C<SQL::Translator> instance is also useful
1041 for informational purposes; for example, the type of the parser can be
1042 retrieved using the C<parser_type> method, and the C<error> and
1043 C<debug> methods can be called when needed.
1045 When defining a producer, one of several things can be passed in: A
1046 module name (e.g., C<My::Groovy::Producer>), a module name relative to
1047 the C<SQL::Translator::Producer> namespace (e.g., C<MySQL>), a module
1048 name and function combination (C<My::Groovy::Producer::transmogrify>),
1049 or a reference to an anonymous subroutine. If a full module name is
1050 passed in (for the purposes of this method, a string containing "::"
1051 is considered to be a module name), it is treated as a package, and a
1052 function called "produce" will be invoked: C<$modulename::produce>.
1053 If $modulename cannot be loaded, the final portion is stripped off and
1054 treated as a function. In other words, if there is no file named
1055 F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
1056 to load F<My/Groovy/Producer.pm> and use C<transmogrify> as the name of
1057 the function, instead of the default C<produce>.
1059 my $tr = SQL::Translator->new;
1061 # This will invoke My::Groovy::Producer::produce($tr, $data)
1062 $tr->producer("My::Groovy::Producer");
1064 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
1065 $tr->producer("Sybase");
1067 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
1068 # assuming that My::Groovy::Producer::transmogrify is not a module
1070 $tr->producer("My::Groovy::Producer::transmogrify");
1072 # This will invoke the referenced subroutine directly, as
1073 # $subref->($tr, $data);
1074 $tr->producer(\&my_producer);
1076 There is also a method named C<producer_type>, which is a string
1077 containing the classname to which the above C<produce> function
1078 belongs. In the case of anonymous subroutines, this method returns
1081 Finally, there is a method named C<producer_args>, which is both an
1082 accessor and a mutator. Arbitrary data may be stored in name => value
1083 pairs for the producer subroutine to access:
1085 sub My::Random::producer {
1086 my ($tr, $data) = @_;
1087 my $pr_args = $tr->producer_args();
1089 # $pr_args is a hashref.
1091 Extra data passed to the C<producer> method is passed to
1094 $tr->producer("xSV", delimiter => ',\s*');
1096 # In SQL::Translator::Producer::xSV:
1097 my $args = $tr->producer_args;
1098 my $delimiter = $args->{'delimiter'}; # value is ,\s*
1102 The C<parser> method defines or retrieves a subroutine that will be
1103 called to perform the parsing. The basic idea is the same as that of
1104 C<producer> (see above), except the default subroutine name is
1105 "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
1106 Also, the parser subroutine will be passed a string containing the
1107 entirety of the data to be parsed.
1109 # Invokes SQL::Translator::Parser::MySQL::parse()
1110 $tr->parser("MySQL");
1112 # Invokes My::Groovy::Parser::parse()
1113 $tr->parser("My::Groovy::Parser");
1115 # Invoke an anonymous subroutine directly
1117 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
1118 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
1119 return $dumper->Dump;
1122 There is also C<parser_type> and C<parser_args>, which perform
1123 analogously to C<producer_type> and C<producer_args>
1127 Set or retreive the filters to run over the schema during the
1128 translation, before the producer creates its output. Filters are sub
1129 routines called, in order, with the schema object to filter as the 1st
1130 arg and a hash of options (passed as a list) for the rest of the args.
1131 They are free to do whatever they want to the schema object, which will be
1132 handed to any following filters, then used by the producer.
1134 Filters are set as an array, which gives the order they run in.
1135 Like parsers and producers, they can be defined by a module name, a
1136 module name relative to the SQL::Translator::Filter namespace, a module
1137 name and function name together or a reference to an anonymous subroutine.
1138 When using a module name a function called C<filter> will be invoked in
1139 that package to do the work.
1141 To pass args to the filter set it as an array ref with the 1st value giving
1142 the filter (name or sub) and the rest its args. e.g.
1147 # Do stuff to schema here!
1150 [ "Names", table => 'lc' ],
1151 [ "Foo", foo => "bar", hello => "world" ],
1155 Although you normally set them in the constructor, which calls
1156 through to filters. i.e.
1158 my $translator = SQL::Translator->new(
1162 [ "Names", table => 'lc' ],
1167 See F<t/36-filters.t> for more examples.
1169 Multiple set calls to filters are cumulative with new filters added to
1170 the end of the current list.
1172 Returns the filters as a list of array refs, the 1st value being a
1173 reference to the filter sub and the rest its args.
1175 =head2 show_warnings
1177 Toggles whether to print warnings of name conflicts, identifier
1178 mutations, etc. Probably only generated by producers to let the user
1179 know when something won't translate very smoothly (e.g., MySQL "enum"
1180 fields into Oracle). Accepts a true or false value, returns the
1185 The C<translate> method calls the subroutine referenced by the
1186 C<parser> data member, then calls any C<filters> and finally calls
1187 the C<producer> sub routine (these members are described above).
1188 It accepts as arguments a number of things, in key => value format,
1189 including (potentially) a parser and a producer (they are passed
1190 directly to the C<parser> and C<producer> methods).
1192 Here is how the parameter list to C<translate> is parsed:
1198 1 argument means it's the data to be parsed; which could be a string
1199 (filename) or a reference to a scalar (a string stored in memory), or a
1200 reference to a hash, which is parsed as being more than one argument
1203 # Parse the file /path/to/datafile
1204 my $output = $tr->translate("/path/to/datafile");
1206 # Parse the data contained in the string $data
1207 my $output = $tr->translate(\$data);
1211 More than 1 argument means its a hash of things, and it might be
1212 setting a parser, producer, or datasource (this key is named
1213 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
1215 # As above, parse /path/to/datafile, but with different producers
1216 for my $prod ("MySQL", "XML", "Sybase") {
1217 print $tr->translate(
1219 filename => "/path/to/datafile",
1223 # The filename hash key could also be:
1224 datasource => \$data,
1230 =head2 filename, data
1232 Using the C<filename> method, the filename of the data to be parsed
1233 can be set. This method can be used in conjunction with the C<data>
1234 method, below. If both the C<filename> and C<data> methods are
1235 invoked as mutators, the data set in the C<data> method is used.
1237 $tr->filename("/my/data/files/create.sql");
1241 my $create_script = do {
1243 open CREATE, "/my/data/files/create.sql" or die $!;
1246 $tr->data(\$create_script);
1248 C<filename> takes a string, which is interpreted as a filename.
1249 C<data> takes a reference to a string, which is used as the data to be
1250 parsed. If a filename is set, then that file is opened and read when
1251 the C<translate> method is called, as long as the data instance
1252 variable is not set.
1256 Returns the SQL::Translator::Schema object.
1260 Turns on/off the tracing option of Parse::RecDescent.
1264 Whether or not to validate the schema object after parsing and before
1269 Returns the version of the SQL::Translator release.
1273 The following people have contributed to the SQLFairy project:
1277 =item * Mark Addison <grommit@users.sourceforge.net>
1279 =item * Sam Angiuoli <angiuoli@users.sourceforge.net>
1281 =item * Anders Nor Berle <berle@cpan.org>
1283 =item * Dave Cash <dave@gnofn.org>
1285 =item * Darren Chamberlain <dlc@users.sourceforge.net>
1287 =item * Ken Y. Clark <kclark@cpan.org>
1289 =item * Allen Day <allenday@users.sourceforge.net>
1291 =item * Paul Harrington <phrrngtn@users.sourceforge.net>
1293 =item * Mikey Melillo <mmelillo@users.sourceforge.net>
1295 =item * Chris Mungall <cjm@fruitfly.org>
1297 =item * Ross Smith II <rossta@users.sf.net>
1299 =item * Gudmundur A. Thorisson <mummi@cshl.org>
1301 =item * Chris To <christot@users.sourceforge.net>
1303 =item * Jason Williams <smdwilliams@users.sourceforge.net>
1305 =item * Ying Zhang <zyolive@yahoo.com>
1307 =item * Daniel Ruoso <daniel@ruoso.com>
1309 =item * Ryan D Johnson <ryan@innerfence.com>
1313 If you would like to contribute to the project, you can send patches
1314 to the developers mailing list:
1316 sqlfairy-developers@lists.sourceforge.net
1318 Or send us a message (with your Sourceforge username) asking to be
1319 added to the project and what you'd like to contribute.
1324 This program is free software; you can redistribute it and/or modify
1325 it under the terms of the GNU General Public License as published by
1326 the Free Software Foundation; version 2.
1328 This program is distributed in the hope that it will be useful, but
1329 WITHOUT ANY WARRANTY; without even the implied warranty of
1330 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1331 General Public License for more details.
1333 You should have received a copy of the GNU General Public License
1334 along with this program; if not, write to the Free Software
1335 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
1340 Please use L<http://rt.cpan.org/> for reporting bugs.
1344 If you find this module useful, please use
1345 L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
1350 L<SQL::Translator::Parser>,
1351 L<SQL::Translator::Producer>,
1352 L<Parse::RecDescent>,
1355 L<Text::RecordParser>,