1 package SQL::Translator;
3 # ----------------------------------------------------------------------
4 # Copyright (C) 2002-2009 The SQLFairy Authors
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License as
8 # published by the Free Software Foundation; version 2.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19 # -------------------------------------------------------------------
22 use vars qw( $VERSION $DEFAULT_SUB $DEBUG $ERROR );
23 use base 'Class::Base';
28 $DEBUG = 0 unless defined $DEBUG;
35 use File::Spec::Functions qw(catfile);
36 use File::Basename qw(dirname);
38 use SQL::Translator::Producer;
39 use SQL::Translator::Schema;
41 # ----------------------------------------------------------------------
42 # The default behavior is to "pass through" values (note that the
43 # SQL::Translator instance is the first value ($_[0]), and the stuff
44 # to be parsed is the second value ($_[1])
45 # ----------------------------------------------------------------------
46 $DEFAULT_SUB = sub { $_[0]->schema } unless defined $DEFAULT_SUB;
48 # ----------------------------------------------------------------------
52 # new takes an optional hash of arguments. These arguments may
53 # include a parser, specified with the keys "parser" or "from",
54 # and a producer, specified with the keys "producer" or "to".
56 # The values that can be passed as the parser or producer are
57 # given directly to the parser or producer methods, respectively.
58 # See the appropriate method description below for details about
59 # what each expects/accepts.
60 # ----------------------------------------------------------------------
62 my ( $self, $config ) = @_;
64 # Set the parser and producer.
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.
70 $self->parser ($config->{'parser'} || $config->{'from'} || $DEFAULT_SUB);
71 $self->producer($config->{'producer'} || $config->{'to'} || $DEFAULT_SUB);
74 # Set up callbacks for formatting of pk,fk,table,package names in producer
75 # MOVED TO PRODUCER ARGS
77 #$self->format_table_name($config->{'format_table_name'});
78 #$self->format_package_name($config->{'format_package_name'});
79 #$self->format_fk_name($config->{'format_fk_name'});
80 #$self->format_pk_name($config->{'format_pk_name'});
83 # Set the parser_args and producer_args
85 for my $pargs ( qw[ parser_args producer_args ] ) {
86 $self->$pargs( $config->{$pargs} ) if defined $config->{ $pargs };
90 # Initialize the filters.
92 if ( $config->{filters} && ref $config->{filters} eq "ARRAY" ) {
93 $self->filters( @{$config->{filters}} )
94 || return $self->error('Error inititializing filters: '.$self->error);
98 # Set the data source, if 'filename' or 'file' is provided.
100 $config->{'filename'} ||= $config->{'file'} || "";
101 $self->filename( $config->{'filename'} ) if $config->{'filename'};
104 # Finally, if there is a 'data' parameter, use that in
105 # preference to filename and file
107 if ( my $data = $config->{'data'} ) {
108 $self->data( $data );
112 # Set various other options.
114 $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
116 $self->add_drop_table( $config->{'add_drop_table'} );
118 $self->no_comments( $config->{'no_comments'} );
120 $self->show_warnings( $config->{'show_warnings'} );
122 $self->trace( $config->{'trace'} );
124 $self->validate( $config->{'validate'} );
126 $self->quote_table_names( (defined $config->{'quote_table_names'}
127 ? $config->{'quote_table_names'} : 1) );
128 $self->quote_field_names( (defined $config->{'quote_field_names'}
129 ? $config->{'quote_field_names'} : 1) );
134 # ----------------------------------------------------------------------
135 # add_drop_table([$bool])
136 # ----------------------------------------------------------------------
139 if ( defined (my $arg = shift) ) {
140 $self->{'add_drop_table'} = $arg ? 1 : 0;
142 return $self->{'add_drop_table'} || 0;
145 # ----------------------------------------------------------------------
146 # no_comments([$bool])
147 # ----------------------------------------------------------------------
151 if ( defined $arg ) {
152 $self->{'no_comments'} = $arg ? 1 : 0;
154 return $self->{'no_comments'} || 0;
158 # ----------------------------------------------------------------------
159 # quote_table_names([$bool])
160 # ----------------------------------------------------------------------
161 sub quote_table_names {
163 if ( defined (my $arg = shift) ) {
164 $self->{'quote_table_names'} = $arg ? 1 : 0;
166 return $self->{'quote_table_names'} || 0;
169 # ----------------------------------------------------------------------
170 # quote_field_names([$bool])
171 # ----------------------------------------------------------------------
172 sub quote_field_names {
174 if ( defined (my $arg = shift) ) {
175 $self->{'quote_field_names'} = $arg ? 1 : 0;
177 return $self->{'quote_field_names'} || 0;
180 # ----------------------------------------------------------------------
181 # producer([$producer_spec])
183 # Get or set the producer for the current translator.
184 # ----------------------------------------------------------------------
188 path => "SQL::Translator::Producer",
189 default_sub => "produce",
193 # ----------------------------------------------------------------------
196 # producer_type is an accessor that allows producer subs to get
197 # information about their origin. This is poptentially important;
198 # since all producer subs are called as subroutine references, there is
199 # no way for a producer to find out which package the sub lives in
200 # originally, for example.
201 # ----------------------------------------------------------------------
202 sub producer_type { $_[0]->{'producer_type'} }
204 # ----------------------------------------------------------------------
205 # producer_args([\%args])
207 # Arbitrary name => value pairs of paramters can be passed to a
208 # producer using this method.
210 # If the first argument passed in is undef, then the hash of arguments
211 # is cleared; all subsequent elements are added to the hash of name,
212 # value pairs stored as producer_args.
213 # ----------------------------------------------------------------------
214 sub producer_args { shift->_args("producer", @_); }
216 # ----------------------------------------------------------------------
217 # parser([$parser_spec])
218 # ----------------------------------------------------------------------
222 path => "SQL::Translator::Parser",
223 default_sub => "parse",
227 sub parser_type { $_[0]->{'parser_type'}; }
229 sub parser_args { shift->_args("parser", @_); }
231 # ----------------------------------------------------------------------
233 # $sqlt->filters => [
235 # [ "NormalizeNames", field => "lc", tabel => "ucfirst" ],
238 # "TEXT" => "BIGTEXT",
241 # ----------------------------------------------------------------------
244 my $filters = $self->{filters} ||= [];
245 return @$filters unless @_;
247 # Set. Convert args to list of [\&code,@args]
249 my ($filt,@args) = ref($_) eq "ARRAY" ? @$_ : $_;
250 if ( isa($filt,"CODE") ) {
251 push @$filters, [$filt,@args];
255 $self->debug("Adding $filt filter. Args:".Dumper(\@args)."\n");
256 $filt = _load_sub("$filt\::filter", "SQL::Translator::Filter")
257 || return $self->error(__PACKAGE__->error);
258 push @$filters, [$filt,@args];
264 # ----------------------------------------------------------------------
268 if ( defined $arg ) {
269 $self->{'show_warnings'} = $arg ? 1 : 0;
271 return $self->{'show_warnings'} || 0;
275 # filename - get or set the filename
279 my $filename = shift;
281 my $msg = "Cannot use directory '$filename' as input source";
282 return $self->error($msg);
283 } elsif (ref($filename) eq 'ARRAY') {
284 $self->{'filename'} = $filename;
285 $self->debug("Got array of files: ".join(', ',@$filename)."\n");
286 } elsif (-f _ && -r _) {
287 $self->{'filename'} = $filename;
288 $self->debug("Got filename: '$self->{'filename'}'\n");
290 my $msg = "Cannot use '$filename' as input source: ".
291 "file does not exist or is not readable.";
292 return $self->error($msg);
299 # ----------------------------------------------------------------------
302 # if $self->{'data'} is not set, but $self->{'filename'} is, then
303 # $self->{'filename'} is opened and read, with the results put into
305 # ----------------------------------------------------------------------
309 # Set $self->{'data'} based on what was passed in. We will
310 # accept a number of things; do our best to get it right.
313 if (isa($data, "SCALAR")) {
314 $self->{'data'} = $data;
317 if (isa($data, 'ARRAY')) {
318 $data = join '', @$data;
320 elsif (isa($data, 'GLOB')) {
321 seek ($data, 0, 0) if eof ($data);
325 elsif (! ref $data && @_) {
326 $data = join '', $data, @_;
328 $self->{'data'} = \$data;
332 # If we have a filename but no data yet, populate.
333 if (not $self->{'data'} and my $filename = $self->filename) {
334 $self->debug("Opening '$filename' to get contents.\n");
339 my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
341 foreach my $file (@files) {
342 unless (open FH, $file) {
343 return $self->error("Can't read file '$file': $!");
349 return $self->error("Can't close file '$file': $!");
353 $self->{'data'} = \$data;
356 return $self->{'data'};
359 # ----------------------------------------------------------------------
362 # Deletes the existing Schema object so that future calls to translate
363 # don't append to the existing.
366 $self->{'schema'} = undef;
370 # ----------------------------------------------------------------------
373 # Returns the SQL::Translator::Schema object
377 unless ( defined $self->{'schema'} ) {
378 $self->{'schema'} = SQL::Translator::Schema->new(
383 return $self->{'schema'};
386 # ----------------------------------------------------------------------
390 if ( defined $arg ) {
391 $self->{'trace'} = $arg ? 1 : 0;
393 return $self->{'trace'} || 0;
396 # ----------------------------------------------------------------------
397 # translate([source], [\%args])
399 # translate does the actual translation. The main argument is the
400 # source of the data to be translated, which can be a filename, scalar
401 # reference, or glob reference.
403 # Alternatively, translate takes optional arguements, which are passed
404 # to the appropriate places. Most notable of these arguments are
405 # parser and producer, which can be used to set the parser and
406 # producer, respectively. This is the applications last chance to set
409 # translate returns a string.
410 # ----------------------------------------------------------------------
413 my ($args, $parser, $parser_type, $producer, $producer_type);
414 my ($parser_output, $producer_output, @producer_output);
418 # Passed a reference to a hash?
419 if (isa($_[0], 'HASH')) {
421 $self->debug("translate: Got a hashref\n");
425 # Passed a GLOB reference, i.e., filehandle
426 elsif (isa($_[0], 'GLOB')) {
427 $self->debug("translate: Got a GLOB reference\n");
431 # Passed a reference to a string containing the data
432 elsif (isa($_[0], 'SCALAR')) {
433 # passed a ref to a string
434 $self->debug("translate: Got a SCALAR reference (string)\n");
438 # Not a reference; treat it as a filename
439 elsif (! ref $_[0]) {
440 # Not a ref, it's a filename
441 $self->debug("translate: Got a filename\n");
442 $self->filename($_[0]);
445 # Passed something else entirely.
447 # We're not impressed. Take your empty string and leave.
450 # Actually, if data, parser, and producer are set, then we
451 # can continue. Too bad, because I like my comment
453 return "" unless ($self->data &&
459 # You must pass in a hash, or you get nothing.
464 # ----------------------------------------------------------------------
465 # Can specify the data to be transformed using "filename", "file",
466 # "data", or "datasource".
467 # ----------------------------------------------------------------------
468 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
469 $self->filename($filename);
472 if (my $data = ($args->{'data'} || $args->{'datasource'})) {
476 # ----------------------------------------------------------------
478 # ----------------------------------------------------------------
479 my $data = $self->data;
481 # ----------------------------------------------------------------
482 # Local reference to the parser subroutine
483 # ----------------------------------------------------------------
484 if ($parser = ($args->{'parser'} || $args->{'from'})) {
485 $self->parser($parser);
487 $parser = $self->parser;
488 $parser_type = $self->parser_type;
490 # ----------------------------------------------------------------
491 # Local reference to the producer subroutine
492 # ----------------------------------------------------------------
493 if ($producer = ($args->{'producer'} || $args->{'to'})) {
494 $self->producer($producer);
496 $producer = $self->producer;
497 $producer_type = $self->producer_type;
499 # ----------------------------------------------------------------
500 # Execute the parser, the filters and then execute the producer.
501 # Allowances are made for each piece to die, or fail to compile,
502 # since the referenced subroutines could be almost anything. In
503 # the future, each of these might happen in a Safe environment,
504 # depending on how paranoid we want to be.
505 # ----------------------------------------------------------------
508 unless ( defined $self->{'schema'} ) {
509 eval { $parser_output = $parser->($self, $$data) };
510 if ($@ || ! $parser_output) {
511 my $msg = sprintf "translate: Error with parser '%s': %s",
512 $parser_type, ($@) ? $@ : " no results";
513 return $self->error($msg);
516 $self->debug("Schema =\n", Dumper($self->schema), "\n");
518 # Validate the schema if asked to.
519 if ($self->validate) {
520 my $schema = $self->schema;
521 return $self->error('Invalid schema') unless $schema->is_valid;
526 foreach ($self->filters) {
528 my ($code,@args) = @$_;
529 eval { $code->($self->schema, @args) };
530 my $err = $@ || $self->error || 0;
531 return $self->error("Error with filter $filt_num : $err") if $err;
535 # Calling wantarray in the eval no work, wrong scope.
536 my $wantarray = wantarray ? 1 : 0;
539 @producer_output = $producer->($self);
541 $producer_output = $producer->($self);
544 if ($@ || !( $producer_output || @producer_output)) {
545 my $err = $@ || $self->error || "no results";
546 my $msg = "translate: Error with producer '$producer_type': $err";
547 return $self->error($msg);
550 return wantarray ? @producer_output : $producer_output;
553 # ----------------------------------------------------------------------
556 # Hacky sort of method to list all available parsers. This has
559 # - Only finds things in the SQL::Translator::Parser namespace
561 # - Only finds things that are located in the same directory
562 # as SQL::Translator::Parser. Yeck.
564 # This method will fail in several very likely cases:
566 # - Parser modules in different namespaces
568 # - Parser modules in the SQL::Translator::Parser namespace that
569 # have any XS componenets will be installed in
570 # arch_lib/SQL/Translator.
572 # ----------------------------------------------------------------------
574 return shift->_list("parser");
577 # ----------------------------------------------------------------------
580 # See notes for list_parsers(), above; all the problems apply to
581 # list_producers as well.
582 # ----------------------------------------------------------------------
584 return shift->_list("producer");
588 # ======================================================================
590 # ======================================================================
592 # ----------------------------------------------------------------------
593 # _args($type, \%args);
595 # Gets or sets ${type}_args. Called by parser_args and producer_args.
596 # ----------------------------------------------------------------------
600 $type = "${type}_args" unless $type =~ /_args$/;
602 unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
603 $self->{$type} = { };
607 # If the first argument is an explicit undef (remember, we
608 # don't get here unless there is stuff in @_), then we clear
609 # out the producer_args hash.
610 if (! defined $_[0]) {
612 %{$self->{$type}} = ();
615 my $args = isa($_[0], 'HASH') ? shift : { @_ };
616 %{$self->{$type}} = (%{$self->{$type}}, %$args);
622 # ----------------------------------------------------------------------
623 # Does the get/set work for parser and producer. e.g.
624 # return $self->_tool({
625 # name => 'producer',
626 # path => "SQL::Translator::Producer",
627 # default_sub => "produce",
629 # ----------------------------------------------------------------------
631 my ($self,$args) = (shift, shift);
632 my $name = $args->{name};
633 return $self->{$name} unless @_; # get accessor
635 my $path = $args->{path};
636 my $default_sub = $args->{default_sub};
639 # passed an anonymous subroutine reference
640 if (isa($tool, 'CODE')) {
641 $self->{$name} = $tool;
642 $self->{"$name\_type"} = "CODE";
643 $self->debug("Got $name: code ref\n");
646 # Module name was passed directly
647 # We try to load the name; if it doesn't load, there's a
648 # possibility that it has a function name attached to it,
649 # so we give it a go.
651 $tool =~ s/-/::/g if $tool !~ /::/;
653 ($code,$sub) = _load_sub("$tool\::$default_sub", $path);
655 if ( __PACKAGE__->error =~ m/Can't find module/ ) {
656 # Mod not found so try sub
657 ($code,$sub) = _load_sub("$tool", $path) unless $code;
658 die "Can't load $name subroutine '$tool' : ".__PACKAGE__->error
662 die "Can't load $name '$tool' : ".__PACKAGE__->error;
666 # get code reference and assign
667 my (undef,$module,undef) = $sub =~ m/((.*)::)?(\w+)$/;
668 $self->{$name} = $code;
669 $self->{"$name\_type"} = $sub eq "CODE" ? "CODE" : $module;
670 $self->debug("Got $name: $sub\n");
673 # At this point, $self->{$name} contains a subroutine
674 # reference that is ready to run
676 # Anything left? If so, it's args
677 my $meth = "$name\_args";
678 $self->$meth(@_) if (@_);
680 return $self->{$name};
683 # ----------------------------------------------------------------------
685 # ----------------------------------------------------------------------
688 my $type = shift || return ();
689 my $uctype = ucfirst lc $type;
692 # First find all the directories where SQL::Translator
693 # parsers or producers (the "type") appear to live.
695 load("SQL::Translator::$uctype") or return ();
696 my $path = catfile "SQL", "Translator", $uctype;
699 my $dir = catfile $_, $path;
700 $self->debug("_list_${type}s searching $dir\n");
706 # Now use File::File::find to look recursively in those
707 # directories for all the *.pm files, then present them
708 # with the slashes turned into dashes.
713 if ( -f && m/\.pm$/ ) {
716 my $cur_dir = $File::Find::dir;
717 my $base_dir = quotemeta catfile 'SQL', 'Translator', $uctype;
720 # See if the current directory is below the base directory.
722 if ( $cur_dir =~ m/$base_dir(.*)/ ) {
724 $cur_dir =~ s!^/!!; # kill leading slash
725 $cur_dir =~ s!/!-!g; # turn other slashes into dashes
731 $found{ join '-', map { $_ || () } $cur_dir, $mod } = 1;
737 return sort { lc $a cmp lc $b } keys %found;
740 # ----------------------------------------------------------------------
741 # load(MODULE [,PATH[,PATH]...])
743 # Loads a Perl module. Short circuits if a module is already loaded.
745 # MODULE - is the name of the module to load.
747 # PATH - optional list of 'package paths' to look for the module in. e.g
748 # If you called load('Super::Foo' => 'My', 'Other') it will
749 # try to load the mod Super::Foo then My::Super::Foo then Other::Super::Foo.
751 # Returns package name of the module actually loaded or false and sets error.
753 # Note, you can't load a name from the root namespace (ie one without '::' in
754 # it), therefore a single word name without a path fails.
755 # ----------------------------------------------------------------------
759 push @path, "" if $name =~ /::/; # Empty path to check name on its own first
760 push @path, @_ if @_;
763 my $module = $_ ? "$_\::$name" : $name;
764 my $file = $module; $file =~ s[::][/]g; $file .= ".pm";
765 __PACKAGE__->debug("Loading $name as $file\n");
766 return $module if $INC{$file}; # Already loaded
768 eval { require $file };
769 next if $@ =~ /Can't locate $file in \@INC/;
770 eval { $module->import() } unless $@;
771 return __PACKAGE__->error("Error loading $name as $module : $@")
772 if $@ && $@ !~ /"SQL::Translator::Producer" is not exported/;
774 return $module; # Module loaded ok
777 return __PACKAGE__->error("Can't find module $name. Path:".join(",",@path));
780 # ----------------------------------------------------------------------
781 # Load the sub name given (including package), optionally using a base package
782 # path. Returns code ref and name of sub loaded, including its package.
783 # (\&code, $sub) = load_sub( 'MySQL::produce', "SQL::Translator::Producer" );
784 # (\&code, $sub) = load_sub( 'MySQL::produce', @path );
785 # ----------------------------------------------------------------------
787 my ($tool, @path) = @_;
789 my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/;
790 if ( my $module = load($module => @path) ) {
791 my $sub = "$module\::$func_name";
792 return wantarray ? ( \&{ $sub }, $sub ) : \&$sub;
797 # ----------------------------------------------------------------------
798 sub format_table_name {
799 return shift->_format_name('_format_table_name', @_);
802 # ----------------------------------------------------------------------
803 sub format_package_name {
804 return shift->_format_name('_format_package_name', @_);
807 # ----------------------------------------------------------------------
809 return shift->_format_name('_format_fk_name', @_);
812 # ----------------------------------------------------------------------
814 return shift->_format_name('_format_pk_name', @_);
817 # ----------------------------------------------------------------------
818 # The other format_*_name methods rely on this one. It optionally
819 # accepts a subroutine ref as the first argument (or uses an identity
820 # sub if one isn't provided or it doesn't already exist), and applies
821 # it to the rest of the arguments (if any).
822 # ----------------------------------------------------------------------
828 if (ref($args[0]) eq 'CODE') {
829 $self->{$field} = shift @args;
831 elsif (! exists $self->{$field}) {
832 $self->{$field} = sub { return shift };
835 return @args ? $self->{$field}->(@args) : $self->{$field};
838 # ----------------------------------------------------------------------
841 # Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
842 # but I like function overhead.
843 # ----------------------------------------------------------------------
845 my ($ref, $type) = @_;
846 return UNIVERSAL::isa($ref, $type);
849 # ----------------------------------------------------------------------
852 # Returns the $VERSION of the main SQL::Translator package.
853 # ----------------------------------------------------------------------
859 # ----------------------------------------------------------------------
861 my ( $self, $arg ) = @_;
862 if ( defined $arg ) {
863 $self->{'validate'} = $arg ? 1 : 0;
865 return $self->{'validate'} || 0;
870 # ----------------------------------------------------------------------
871 # Who killed the pork chops?
872 # What price bananas?
875 # ----------------------------------------------------------------------
881 SQL::Translator - manipulate structured data definitions (SQL and more)
887 my $translator = SQL::Translator->new(
890 # Print Parse::RecDescent trace
892 # Don't include comments in output
894 # Print name mutations, conflicts
896 # Add "drop table" statements
898 # to quote or not to quote, thats the question
899 quote_table_names => 1,
900 quote_field_names => 1,
901 # Validate schema object
903 # Make all table names CAPS in producers which support this option
904 format_table_name => sub {my $tablename = shift; return uc($tablename)},
905 # Null-op formatting, only here for documentation's sake
906 format_package_name => sub {return shift},
907 format_fk_name => sub {return shift},
908 format_pk_name => sub {return shift},
911 my $output = $translator->translate(
914 # Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
916 ) or die $translator->error;
922 This documentation covers the API for SQL::Translator. For a more general
923 discussion of how to use the modules and scripts, please see
924 L<SQL::Translator::Manual>.
926 SQL::Translator is a group of Perl modules that converts
927 vendor-specific SQL table definitions into other formats, such as
928 other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
929 XML, and Class::DBI classes. The main focus of SQL::Translator is
930 SQL, but parsers exist for other structured data formats, including
931 Excel spreadsheets and arbitrarily delimited text files. Through the
932 separation of the code into parsers and producers with an object model
933 in between, it's possible to combine any parser with any producer, to
934 plug in custom parsers or producers, or to manipulate the parsed data
935 via the built-in object model. Presently only the definition parts of
936 SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
941 The constructor is called C<new>, and accepts a optional hash of options.
1004 All options are, well, optional; these attributes can be set via
1005 instance methods. Internally, they are; no (non-syntactical)
1006 advantage is gained by passing options to the constructor.
1010 =head2 add_drop_table
1012 Toggles whether or not to add "DROP TABLE" statements just before the
1015 =head2 quote_table_names
1017 Toggles whether or not to quote table names with " in DROP and CREATE
1018 statements. The default (true) is to quote them.
1020 =head2 quote_field_names
1022 Toggles whether or not to quote field names with " in most
1023 statements. The default (true), is to quote them.
1027 Toggles whether to print comments in the output. Accepts a true or false
1028 value, returns the current value.
1032 The C<producer> method is an accessor/mutator, used to retrieve or
1033 define what subroutine is called to produce the output. A subroutine
1034 defined as a producer will be invoked as a function (I<not a method>)
1035 and passed its container C<SQL::Translator> instance, which it should
1036 call the C<schema> method on, to get the C<SQL::Translator::Schema>
1037 generated by the parser. It is expected that the function transform the
1038 schema structure to a string. The C<SQL::Translator> instance is also useful
1039 for informational purposes; for example, the type of the parser can be
1040 retrieved using the C<parser_type> method, and the C<error> and
1041 C<debug> methods can be called when needed.
1043 When defining a producer, one of several things can be passed in: A
1044 module name (e.g., C<My::Groovy::Producer>), a module name relative to
1045 the C<SQL::Translator::Producer> namespace (e.g., C<MySQL>), a module
1046 name and function combination (C<My::Groovy::Producer::transmogrify>),
1047 or a reference to an anonymous subroutine. If a full module name is
1048 passed in (for the purposes of this method, a string containing "::"
1049 is considered to be a module name), it is treated as a package, and a
1050 function called "produce" will be invoked: C<$modulename::produce>.
1051 If $modulename cannot be loaded, the final portion is stripped off and
1052 treated as a function. In other words, if there is no file named
1053 F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
1054 to load F<My/Groovy/Producer.pm> and use C<transmogrify> as the name of
1055 the function, instead of the default C<produce>.
1057 my $tr = SQL::Translator->new;
1059 # This will invoke My::Groovy::Producer::produce($tr, $data)
1060 $tr->producer("My::Groovy::Producer");
1062 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
1063 $tr->producer("Sybase");
1065 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
1066 # assuming that My::Groovy::Producer::transmogrify is not a module
1068 $tr->producer("My::Groovy::Producer::transmogrify");
1070 # This will invoke the referenced subroutine directly, as
1071 # $subref->($tr, $data);
1072 $tr->producer(\&my_producer);
1074 There is also a method named C<producer_type>, which is a string
1075 containing the classname to which the above C<produce> function
1076 belongs. In the case of anonymous subroutines, this method returns
1079 Finally, there is a method named C<producer_args>, which is both an
1080 accessor and a mutator. Arbitrary data may be stored in name => value
1081 pairs for the producer subroutine to access:
1083 sub My::Random::producer {
1084 my ($tr, $data) = @_;
1085 my $pr_args = $tr->producer_args();
1087 # $pr_args is a hashref.
1089 Extra data passed to the C<producer> method is passed to
1092 $tr->producer("xSV", delimiter => ',\s*');
1094 # In SQL::Translator::Producer::xSV:
1095 my $args = $tr->producer_args;
1096 my $delimiter = $args->{'delimiter'}; # value is ,\s*
1100 The C<parser> method defines or retrieves a subroutine that will be
1101 called to perform the parsing. The basic idea is the same as that of
1102 C<producer> (see above), except the default subroutine name is
1103 "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
1104 Also, the parser subroutine will be passed a string containing the
1105 entirety of the data to be parsed.
1107 # Invokes SQL::Translator::Parser::MySQL::parse()
1108 $tr->parser("MySQL");
1110 # Invokes My::Groovy::Parser::parse()
1111 $tr->parser("My::Groovy::Parser");
1113 # Invoke an anonymous subroutine directly
1115 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
1116 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
1117 return $dumper->Dump;
1120 There is also C<parser_type> and C<parser_args>, which perform
1121 analogously to C<producer_type> and C<producer_args>
1125 Set or retreive the filters to run over the schema during the
1126 translation, before the producer creates its output. Filters are sub
1127 routines called, in order, with the schema object to filter as the 1st
1128 arg and a hash of options (passed as a list) for the rest of the args.
1129 They are free to do whatever they want to the schema object, which will be
1130 handed to any following filters, then used by the producer.
1132 Filters are set as an array, which gives the order they run in.
1133 Like parsers and producers, they can be defined by a module name, a
1134 module name relative to the SQL::Translator::Filter namespace, a module
1135 name and function name together or a reference to an anonymous subroutine.
1136 When using a module name a function called C<filter> will be invoked in
1137 that package to do the work.
1139 To pass args to the filter set it as an array ref with the 1st value giving
1140 the filter (name or sub) and the rest its args. e.g.
1145 # Do stuff to schema here!
1148 [ "Names", table => 'lc' ],
1149 [ "Foo", foo => "bar", hello => "world" ],
1153 Although you normally set them in the constructor, which calls
1154 through to filters. i.e.
1156 my $translator = SQL::Translator->new(
1160 [ "Names", table => 'lc' ],
1165 See F<t/36-filters.t> for more examples.
1167 Multiple set calls to filters are cumulative with new filters added to
1168 the end of the current list.
1170 Returns the filters as a list of array refs, the 1st value being a
1171 reference to the filter sub and the rest its args.
1173 =head2 show_warnings
1175 Toggles whether to print warnings of name conflicts, identifier
1176 mutations, etc. Probably only generated by producers to let the user
1177 know when something won't translate very smoothly (e.g., MySQL "enum"
1178 fields into Oracle). Accepts a true or false value, returns the
1183 The C<translate> method calls the subroutine referenced by the
1184 C<parser> data member, then calls any C<filters> and finally calls
1185 the C<producer> sub routine (these members are described above).
1186 It accepts as arguments a number of things, in key => value format,
1187 including (potentially) a parser and a producer (they are passed
1188 directly to the C<parser> and C<producer> methods).
1190 Here is how the parameter list to C<translate> is parsed:
1196 1 argument means it's the data to be parsed; which could be a string
1197 (filename) or a reference to a scalar (a string stored in memory), or a
1198 reference to a hash, which is parsed as being more than one argument
1201 # Parse the file /path/to/datafile
1202 my $output = $tr->translate("/path/to/datafile");
1204 # Parse the data contained in the string $data
1205 my $output = $tr->translate(\$data);
1209 More than 1 argument means its a hash of things, and it might be
1210 setting a parser, producer, or datasource (this key is named
1211 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
1213 # As above, parse /path/to/datafile, but with different producers
1214 for my $prod ("MySQL", "XML", "Sybase") {
1215 print $tr->translate(
1217 filename => "/path/to/datafile",
1221 # The filename hash key could also be:
1222 datasource => \$data,
1228 =head2 filename, data
1230 Using the C<filename> method, the filename of the data to be parsed
1231 can be set. This method can be used in conjunction with the C<data>
1232 method, below. If both the C<filename> and C<data> methods are
1233 invoked as mutators, the data set in the C<data> method is used.
1235 $tr->filename("/my/data/files/create.sql");
1239 my $create_script = do {
1241 open CREATE, "/my/data/files/create.sql" or die $!;
1244 $tr->data(\$create_script);
1246 C<filename> takes a string, which is interpreted as a filename.
1247 C<data> takes a reference to a string, which is used as the data to be
1248 parsed. If a filename is set, then that file is opened and read when
1249 the C<translate> method is called, as long as the data instance
1250 variable is not set.
1254 Returns the SQL::Translator::Schema object.
1258 Turns on/off the tracing option of Parse::RecDescent.
1262 Whether or not to validate the schema object after parsing and before
1267 Returns the version of the SQL::Translator release.
1271 See the included AUTHORS file:
1272 L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
1274 If you would like to contribute to the project, you can send patches
1275 to the developers mailing list:
1277 sqlfairy-developers@lists.sourceforge.net
1279 Or send us a message (with your Sourceforge username) asking to be
1280 added to the project and what you'd like to contribute.
1285 This program is free software; you can redistribute it and/or modify
1286 it under the terms of the GNU General Public License as published by
1287 the Free Software Foundation; version 2.
1289 This program is distributed in the hope that it will be useful, but
1290 WITHOUT ANY WARRANTY; without even the implied warranty of
1291 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1292 General Public License for more details.
1294 You should have received a copy of the GNU General Public License
1295 along with this program; if not, write to the Free Software
1296 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
1301 Please use L<http://rt.cpan.org/> for reporting bugs.
1305 If you find this module useful, please use
1306 L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
1311 L<SQL::Translator::Parser>,
1312 L<SQL::Translator::Producer>,
1313 L<Parse::RecDescent>,
1316 L<Text::RecordParser>,