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::Producer;
43 use SQL::Translator::Schema;
45 # ----------------------------------------------------------------------
46 # The default behavior is to "pass through" values (note that the
47 # SQL::Translator instance is the first value ($_[0]), and the stuff
48 # to be parsed is the second value ($_[1])
49 # ----------------------------------------------------------------------
50 $DEFAULT_SUB = sub { $_[0]->schema } unless defined $DEFAULT_SUB;
52 # ----------------------------------------------------------------------
56 # new takes an optional hash of arguments. These arguments may
57 # include a parser, specified with the keys "parser" or "from",
58 # and a producer, specified with the keys "producer" or "to".
60 # The values that can be passed as the parser or producer are
61 # given directly to the parser or producer methods, respectively.
62 # See the appropriate method description below for details about
63 # what each expects/accepts.
64 # ----------------------------------------------------------------------
66 my ( $self, $config ) = @_;
68 # Set the parser and producer.
70 # If a 'parser' or 'from' parameter is passed in, use that as the
71 # parser; if a 'producer' or 'to' parameter is passed in, use that
72 # as the producer; both default to $DEFAULT_SUB.
74 $self->parser ($config->{'parser'} || $config->{'from'} || $DEFAULT_SUB);
75 $self->producer($config->{'producer'} || $config->{'to'} || $DEFAULT_SUB);
78 # Set up callbacks for formatting of pk,fk,table,package names in producer
79 # MOVED TO PRODUCER ARGS
81 #$self->format_table_name($config->{'format_table_name'});
82 #$self->format_package_name($config->{'format_package_name'});
83 #$self->format_fk_name($config->{'format_fk_name'});
84 #$self->format_pk_name($config->{'format_pk_name'});
87 # Set the parser_args and producer_args
89 for my $pargs ( qw[ parser_args producer_args ] ) {
90 $self->$pargs( $config->{$pargs} ) if defined $config->{ $pargs };
94 # Initialize the filters.
96 if ( $config->{filters} && ref $config->{filters} eq "ARRAY" ) {
97 $self->filters( @{$config->{filters}} )
98 || return $self->error('Error inititializing filters: '.$self->error);
102 # Set the data source, if 'filename' or 'file' is provided.
104 $config->{'filename'} ||= $config->{'file'} || "";
105 $self->filename( $config->{'filename'} ) if $config->{'filename'};
108 # Finally, if there is a 'data' parameter, use that in
109 # preference to filename and file
111 if ( my $data = $config->{'data'} ) {
112 $self->data( $data );
116 # Set various other options.
118 $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
120 $self->add_drop_table( $config->{'add_drop_table'} );
122 $self->no_comments( $config->{'no_comments'} );
124 $self->show_warnings( $config->{'show_warnings'} );
126 $self->trace( $config->{'trace'} );
128 $self->validate( $config->{'validate'} );
130 $self->quote_table_names( (defined $config->{'quote_table_names'}
131 ? $config->{'quote_table_names'} : 1) );
132 $self->quote_field_names( (defined $config->{'quote_field_names'}
133 ? $config->{'quote_field_names'} : 1) );
138 # ----------------------------------------------------------------------
139 # add_drop_table([$bool])
140 # ----------------------------------------------------------------------
143 if ( defined (my $arg = shift) ) {
144 $self->{'add_drop_table'} = $arg ? 1 : 0;
146 return $self->{'add_drop_table'} || 0;
149 # ----------------------------------------------------------------------
150 # no_comments([$bool])
151 # ----------------------------------------------------------------------
155 if ( defined $arg ) {
156 $self->{'no_comments'} = $arg ? 1 : 0;
158 return $self->{'no_comments'} || 0;
162 # ----------------------------------------------------------------------
163 # quote_table_names([$bool])
164 # ----------------------------------------------------------------------
165 sub quote_table_names {
167 if ( defined (my $arg = shift) ) {
168 $self->{'quote_table_names'} = $arg ? 1 : 0;
170 return $self->{'quote_table_names'} || 0;
173 # ----------------------------------------------------------------------
174 # quote_field_names([$bool])
175 # ----------------------------------------------------------------------
176 sub quote_field_names {
178 if ( defined (my $arg = shift) ) {
179 $self->{'quote_field_names'} = $arg ? 1 : 0;
181 return $self->{'quote_field_names'} || 0;
184 # ----------------------------------------------------------------------
185 # producer([$producer_spec])
187 # Get or set the producer for the current translator.
188 # ----------------------------------------------------------------------
192 path => "SQL::Translator::Producer",
193 default_sub => "produce",
197 # ----------------------------------------------------------------------
200 # producer_type is an accessor that allows producer subs to get
201 # information about their origin. This is poptentially important;
202 # since all producer subs are called as subroutine references, there is
203 # no way for a producer to find out which package the sub lives in
204 # originally, for example.
205 # ----------------------------------------------------------------------
206 sub producer_type { $_[0]->{'producer_type'} }
208 # ----------------------------------------------------------------------
209 # producer_args([\%args])
211 # Arbitrary name => value pairs of paramters can be passed to a
212 # producer using this method.
214 # If the first argument passed in is undef, then the hash of arguments
215 # is cleared; all subsequent elements are added to the hash of name,
216 # value pairs stored as producer_args.
217 # ----------------------------------------------------------------------
218 sub producer_args { shift->_args("producer", @_); }
220 # ----------------------------------------------------------------------
221 # parser([$parser_spec])
222 # ----------------------------------------------------------------------
226 path => "SQL::Translator::Parser",
227 default_sub => "parse",
231 sub parser_type { $_[0]->{'parser_type'}; }
233 sub parser_args { shift->_args("parser", @_); }
235 # ----------------------------------------------------------------------
237 # $sqlt->filters => [
239 # [ "NormalizeNames", field => "lc", tabel => "ucfirst" ],
242 # "TEXT" => "BIGTEXT",
245 # ----------------------------------------------------------------------
248 my $filters = $self->{filters} ||= [];
249 return @$filters unless @_;
251 # Set. Convert args to list of [\&code,@args]
253 my ($filt,@args) = ref($_) eq "ARRAY" ? @$_ : $_;
254 if ( isa($filt,"CODE") ) {
255 push @$filters, [$filt,@args];
259 $self->debug("Adding $filt filter. Args:".Dumper(\@args)."\n");
260 $filt = _load_sub("$filt\::filter", "SQL::Translator::Filter")
261 || return $self->error(__PACKAGE__->error);
262 push @$filters, [$filt,@args];
268 # ----------------------------------------------------------------------
272 if ( defined $arg ) {
273 $self->{'show_warnings'} = $arg ? 1 : 0;
275 return $self->{'show_warnings'} || 0;
279 # filename - get or set the filename
283 my $filename = shift;
285 my $msg = "Cannot use directory '$filename' as input source";
286 return $self->error($msg);
287 } elsif (ref($filename) eq 'ARRAY') {
288 $self->{'filename'} = $filename;
289 $self->debug("Got array of files: ".join(', ',@$filename)."\n");
290 } elsif (-f _ && -r _) {
291 $self->{'filename'} = $filename;
292 $self->debug("Got filename: '$self->{'filename'}'\n");
294 my $msg = "Cannot use '$filename' as input source: ".
295 "file does not exist or is not readable.";
296 return $self->error($msg);
303 # ----------------------------------------------------------------------
306 # if $self->{'data'} is not set, but $self->{'filename'} is, then
307 # $self->{'filename'} is opened and read, with the results put into
309 # ----------------------------------------------------------------------
313 # Set $self->{'data'} based on what was passed in. We will
314 # accept a number of things; do our best to get it right.
317 if (isa($data, "SCALAR")) {
318 $self->{'data'} = $data;
321 if (isa($data, 'ARRAY')) {
322 $data = join '', @$data;
324 elsif (isa($data, 'GLOB')) {
328 elsif (! ref $data && @_) {
329 $data = join '', $data, @_;
331 $self->{'data'} = \$data;
335 # If we have a filename but no data yet, populate.
336 if (not $self->{'data'} and my $filename = $self->filename) {
337 $self->debug("Opening '$filename' to get contents.\n");
342 my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
344 foreach my $file (@files) {
345 unless (open FH, $file) {
346 return $self->error("Can't read file '$file': $!");
352 return $self->error("Can't close file '$file': $!");
356 $self->{'data'} = \$data;
359 return $self->{'data'};
362 # ----------------------------------------------------------------------
365 # Deletes the existing Schema object so that future calls to translate
366 # don't append to the existing.
369 $self->{'schema'} = undef;
373 # ----------------------------------------------------------------------
376 # Returns the SQL::Translator::Schema object
380 unless ( defined $self->{'schema'} ) {
381 $self->{'schema'} = SQL::Translator::Schema->new(
386 return $self->{'schema'};
389 # ----------------------------------------------------------------------
393 if ( defined $arg ) {
394 $self->{'trace'} = $arg ? 1 : 0;
396 return $self->{'trace'} || 0;
399 # ----------------------------------------------------------------------
400 # translate([source], [\%args])
402 # translate does the actual translation. The main argument is the
403 # source of the data to be translated, which can be a filename, scalar
404 # reference, or glob reference.
406 # Alternatively, translate takes optional arguements, which are passed
407 # to the appropriate places. Most notable of these arguments are
408 # parser and producer, which can be used to set the parser and
409 # producer, respectively. This is the applications last chance to set
412 # translate returns a string.
413 # ----------------------------------------------------------------------
416 my ($args, $parser, $parser_type, $producer, $producer_type);
417 my ($parser_output, $producer_output, @producer_output);
421 # Passed a reference to a hash?
422 if (isa($_[0], 'HASH')) {
424 $self->debug("translate: Got a hashref\n");
428 # Passed a GLOB reference, i.e., filehandle
429 elsif (isa($_[0], 'GLOB')) {
430 $self->debug("translate: Got a GLOB reference\n");
434 # Passed a reference to a string containing the data
435 elsif (isa($_[0], 'SCALAR')) {
436 # passed a ref to a string
437 $self->debug("translate: Got a SCALAR reference (string)\n");
441 # Not a reference; treat it as a filename
442 elsif (! ref $_[0]) {
443 # Not a ref, it's a filename
444 $self->debug("translate: Got a filename\n");
445 $self->filename($_[0]);
448 # Passed something else entirely.
450 # We're not impressed. Take your empty string and leave.
453 # Actually, if data, parser, and producer are set, then we
454 # can continue. Too bad, because I like my comment
456 return "" unless ($self->data &&
462 # You must pass in a hash, or you get nothing.
467 # ----------------------------------------------------------------------
468 # Can specify the data to be transformed using "filename", "file",
469 # "data", or "datasource".
470 # ----------------------------------------------------------------------
471 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
472 $self->filename($filename);
475 if (my $data = ($args->{'data'} || $args->{'datasource'})) {
479 # ----------------------------------------------------------------
481 # ----------------------------------------------------------------
482 my $data = $self->data;
484 # ----------------------------------------------------------------
485 # Local reference to the parser subroutine
486 # ----------------------------------------------------------------
487 if ($parser = ($args->{'parser'} || $args->{'from'})) {
488 $self->parser($parser);
490 $parser = $self->parser;
491 $parser_type = $self->parser_type;
493 # ----------------------------------------------------------------
494 # Local reference to the producer subroutine
495 # ----------------------------------------------------------------
496 if ($producer = ($args->{'producer'} || $args->{'to'})) {
497 $self->producer($producer);
499 $producer = $self->producer;
500 $producer_type = $self->producer_type;
502 # ----------------------------------------------------------------
503 # Execute the parser, the filters and then execute the producer.
504 # Allowances are made for each piece to die, or fail to compile,
505 # since the referenced subroutines could be almost anything. In
506 # the future, each of these might happen in a Safe environment,
507 # depending on how paranoid we want to be.
508 # ----------------------------------------------------------------
511 unless ( defined $self->{'schema'} ) {
512 eval { $parser_output = $parser->($self, $$data) };
513 if ($@ || ! $parser_output) {
514 my $msg = sprintf "translate: Error with parser '%s': %s",
515 $parser_type, ($@) ? $@ : " no results";
516 return $self->error($msg);
519 $self->debug("Schema =\n", Dumper($self->schema), "\n");
521 # Validate the schema if asked to.
522 if ($self->validate) {
523 my $schema = $self->schema;
524 return $self->error('Invalid schema') unless $schema->is_valid;
529 foreach ($self->filters) {
531 my ($code,@args) = @$_;
532 eval { $code->($self->schema, @args) };
533 my $err = $@ || $self->error || 0;
534 return $self->error("Error with filter $filt_num : $err") if $err;
538 # Calling wantarray in the eval no work, wrong scope.
539 my $wantarray = wantarray ? 1 : 0;
542 @producer_output = $producer->($self);
544 $producer_output = $producer->($self);
547 if ($@ || !( $producer_output || @producer_output)) {
548 my $err = $@ || $self->error || "no results";
549 my $msg = "translate: Error with producer '$producer_type': $err";
550 return $self->error($msg);
553 return wantarray ? @producer_output : $producer_output;
556 # ----------------------------------------------------------------------
559 # Hacky sort of method to list all available parsers. This has
562 # - Only finds things in the SQL::Translator::Parser namespace
564 # - Only finds things that are located in the same directory
565 # as SQL::Translator::Parser. Yeck.
567 # This method will fail in several very likely cases:
569 # - Parser modules in different namespaces
571 # - Parser modules in the SQL::Translator::Parser namespace that
572 # have any XS componenets will be installed in
573 # arch_lib/SQL/Translator.
575 # ----------------------------------------------------------------------
577 return shift->_list("parser");
580 # ----------------------------------------------------------------------
583 # See notes for list_parsers(), above; all the problems apply to
584 # list_producers as well.
585 # ----------------------------------------------------------------------
587 return shift->_list("producer");
591 # ======================================================================
593 # ======================================================================
595 # ----------------------------------------------------------------------
596 # _args($type, \%args);
598 # Gets or sets ${type}_args. Called by parser_args and producer_args.
599 # ----------------------------------------------------------------------
603 $type = "${type}_args" unless $type =~ /_args$/;
605 unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
606 $self->{$type} = { };
610 # If the first argument is an explicit undef (remember, we
611 # don't get here unless there is stuff in @_), then we clear
612 # out the producer_args hash.
613 if (! defined $_[0]) {
615 %{$self->{$type}} = ();
618 my $args = isa($_[0], 'HASH') ? shift : { @_ };
619 %{$self->{$type}} = (%{$self->{$type}}, %$args);
625 # ----------------------------------------------------------------------
626 # Does the get/set work for parser and producer. e.g.
627 # return $self->_tool({
628 # name => 'producer',
629 # path => "SQL::Translator::Producer",
630 # default_sub => "produce",
632 # ----------------------------------------------------------------------
634 my ($self,$args) = (shift, shift);
635 my $name = $args->{name};
636 return $self->{$name} unless @_; # get accessor
638 my $path = $args->{path};
639 my $default_sub = $args->{default_sub};
642 # passed an anonymous subroutine reference
643 if (isa($tool, 'CODE')) {
644 $self->{$name} = $tool;
645 $self->{"$name\_type"} = "CODE";
646 $self->debug("Got $name: code ref\n");
649 # Module name was passed directly
650 # We try to load the name; if it doesn't load, there's a
651 # possibility that it has a function name attached to it,
652 # so we give it a go.
654 $tool =~ s/-/::/g if $tool !~ /::/;
656 ($code,$sub) = _load_sub("$tool\::$default_sub", $path);
658 if ( __PACKAGE__->error =~ m/Can't find module/ ) {
659 # Mod not found so try sub
660 ($code,$sub) = _load_sub("$tool", $path) unless $code;
661 die "Can't load $name subroutine '$tool' : ".__PACKAGE__->error
665 die "Can't load $name '$tool' : ".__PACKAGE__->error;
669 # get code reference and assign
670 my (undef,$module,undef) = $sub =~ m/((.*)::)?(\w+)$/;
671 $self->{$name} = $code;
672 $self->{"$name\_type"} = $sub eq "CODE" ? "CODE" : $module;
673 $self->debug("Got $name: $sub\n");
676 # At this point, $self->{$name} contains a subroutine
677 # reference that is ready to run
679 # Anything left? If so, it's args
680 my $meth = "$name\_args";
681 $self->$meth(@_) if (@_);
683 return $self->{$name};
686 # ----------------------------------------------------------------------
688 # ----------------------------------------------------------------------
691 my $type = shift || return ();
692 my $uctype = ucfirst lc $type;
695 # First find all the directories where SQL::Translator
696 # parsers or producers (the "type") appear to live.
698 load("SQL::Translator::$uctype") or return ();
699 my $path = catfile "SQL", "Translator", $uctype;
702 my $dir = catfile $_, $path;
703 $self->debug("_list_${type}s searching $dir\n");
709 # Now use File::File::find to look recursively in those
710 # directories for all the *.pm files, then present them
711 # with the slashes turned into dashes.
716 if ( -f && m/\.pm$/ ) {
719 my $cur_dir = $File::Find::dir;
720 my $base_dir = quotemeta catfile 'SQL', 'Translator', $uctype;
723 # See if the current directory is below the base directory.
725 if ( $cur_dir =~ m/$base_dir(.*)/ ) {
727 $cur_dir =~ s!^/!!; # kill leading slash
728 $cur_dir =~ s!/!-!g; # turn other slashes into dashes
734 $found{ join '-', map { $_ || () } $cur_dir, $mod } = 1;
740 return sort { lc $a cmp lc $b } keys %found;
743 # ----------------------------------------------------------------------
744 # load(MODULE [,PATH[,PATH]...])
746 # Loads a Perl module. Short circuits if a module is already loaded.
748 # MODULE - is the name of the module to load.
750 # PATH - optional list of 'package paths' to look for the module in. e.g
751 # If you called load('Super::Foo' => 'My', 'Other') it will
752 # try to load the mod Super::Foo then My::Super::Foo then Other::Super::Foo.
754 # Returns package name of the module actually loaded or false and sets error.
756 # Note, you can't load a name from the root namespace (ie one without '::' in
757 # it), therefore a single word name without a path fails.
758 # ----------------------------------------------------------------------
762 push @path, "" if $name =~ /::/; # Empty path to check name on its own first
763 push @path, @_ if @_;
766 my $module = $_ ? "$_\::$name" : $name;
767 my $file = $module; $file =~ s[::][/]g; $file .= ".pm";
768 __PACKAGE__->debug("Loading $name as $file\n");
769 return $module if $INC{$file}; # Already loaded
771 eval { require $file };
772 next if $@ =~ /Can't locate $file in \@INC/;
773 eval { $module->import() } unless $@;
774 return __PACKAGE__->error("Error loading $name as $module : $@")
775 if $@ && $@ !~ /"SQL::Translator::Producer" is not exported/;
777 return $module; # Module loaded ok
780 return __PACKAGE__->error("Can't find module $name. Path:".join(",",@path));
783 # ----------------------------------------------------------------------
784 # Load the sub name given (including package), optionally using a base package
785 # path. Returns code ref and name of sub loaded, including its package.
786 # (\&code, $sub) = load_sub( 'MySQL::produce', "SQL::Translator::Producer" );
787 # (\&code, $sub) = load_sub( 'MySQL::produce', @path );
788 # ----------------------------------------------------------------------
790 my ($tool, @path) = @_;
792 my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/;
793 if ( my $module = load($module => @path) ) {
794 my $sub = "$module\::$func_name";
795 return wantarray ? ( \&{ $sub }, $sub ) : \&$sub;
800 # ----------------------------------------------------------------------
801 sub format_table_name {
802 return shift->_format_name('_format_table_name', @_);
805 # ----------------------------------------------------------------------
806 sub format_package_name {
807 return shift->_format_name('_format_package_name', @_);
810 # ----------------------------------------------------------------------
812 return shift->_format_name('_format_fk_name', @_);
815 # ----------------------------------------------------------------------
817 return shift->_format_name('_format_pk_name', @_);
820 # ----------------------------------------------------------------------
821 # The other format_*_name methods rely on this one. It optionally
822 # accepts a subroutine ref as the first argument (or uses an identity
823 # sub if one isn't provided or it doesn't already exist), and applies
824 # it to the rest of the arguments (if any).
825 # ----------------------------------------------------------------------
831 if (ref($args[0]) eq 'CODE') {
832 $self->{$field} = shift @args;
834 elsif (! exists $self->{$field}) {
835 $self->{$field} = sub { return shift };
838 return @args ? $self->{$field}->(@args) : $self->{$field};
841 # ----------------------------------------------------------------------
844 # Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
845 # but I like function overhead.
846 # ----------------------------------------------------------------------
848 my ($ref, $type) = @_;
849 return UNIVERSAL::isa($ref, $type);
852 # ----------------------------------------------------------------------
855 # Returns the $VERSION of the main SQL::Translator package.
856 # ----------------------------------------------------------------------
862 # ----------------------------------------------------------------------
864 my ( $self, $arg ) = @_;
865 if ( defined $arg ) {
866 $self->{'validate'} = $arg ? 1 : 0;
868 return $self->{'validate'} || 0;
873 # ----------------------------------------------------------------------
874 # Who killed the pork chops?
875 # What price bananas?
878 # ----------------------------------------------------------------------
884 SQL::Translator - manipulate structured data definitions (SQL and more)
890 my $translator = SQL::Translator->new(
893 # Print Parse::RecDescent trace
895 # Don't include comments in output
897 # Print name mutations, conflicts
899 # Add "drop table" statements
901 # to quote or not to quote, thats the question
902 quote_table_names => 1,
903 quote_field_names => 1,
904 # Validate schema object
906 # Make all table names CAPS in producers which support this option
907 format_table_name => sub {my $tablename = shift; return uc($tablename)},
908 # Null-op formatting, only here for documentation's sake
909 format_package_name => sub {return shift},
910 format_fk_name => sub {return shift},
911 format_pk_name => sub {return shift},
914 my $output = $translator->translate(
917 # Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
919 ) or die $translator->error;
925 This documentation covers the API for SQL::Translator. For a more general
926 discussion of how to use the modules and scripts, please see
927 L<SQL::Translator::Manual>.
929 SQL::Translator is a group of Perl modules that converts
930 vendor-specific SQL table definitions into other formats, such as
931 other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
932 XML, and Class::DBI classes. The main focus of SQL::Translator is
933 SQL, but parsers exist for other structured data formats, including
934 Excel spreadsheets and arbitrarily delimited text files. Through the
935 separation of the code into parsers and producers with an object model
936 in between, it's possible to combine any parser with any producer, to
937 plug in custom parsers or producers, or to manipulate the parsed data
938 via the built-in object model. Presently only the definition parts of
939 SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
944 The constructor is called C<new>, and accepts a optional hash of options.
1007 All options are, well, optional; these attributes can be set via
1008 instance methods. Internally, they are; no (non-syntactical)
1009 advantage is gained by passing options to the constructor.
1013 =head2 add_drop_table
1015 Toggles whether or not to add "DROP TABLE" statements just before the
1018 =head2 quote_table_names
1020 Toggles whether or not to quote table names with " in DROP and CREATE
1021 statements. The default (true) is to quote them.
1023 =head2 quote_field_names
1025 Toggles whether or not to quote field names with " in most
1026 statements. The default (true), is to quote them.
1030 Toggles whether to print comments in the output. Accepts a true or false
1031 value, returns the current value.
1035 The C<producer> method is an accessor/mutator, used to retrieve or
1036 define what subroutine is called to produce the output. A subroutine
1037 defined as a producer will be invoked as a function (I<not a method>)
1038 and passed its container C<SQL::Translator> instance, which it should
1039 call the C<schema> method on, to get the C<SQL::Translator::Schema>
1040 generated by the parser. It is expected that the function transform the
1041 schema structure to a string. The C<SQL::Translator> instance is also useful
1042 for informational purposes; for example, the type of the parser can be
1043 retrieved using the C<parser_type> method, and the C<error> and
1044 C<debug> methods can be called when needed.
1046 When defining a producer, one of several things can be passed in: A
1047 module name (e.g., C<My::Groovy::Producer>), a module name relative to
1048 the C<SQL::Translator::Producer> namespace (e.g., C<MySQL>), a module
1049 name and function combination (C<My::Groovy::Producer::transmogrify>),
1050 or a reference to an anonymous subroutine. If a full module name is
1051 passed in (for the purposes of this method, a string containing "::"
1052 is considered to be a module name), it is treated as a package, and a
1053 function called "produce" will be invoked: C<$modulename::produce>.
1054 If $modulename cannot be loaded, the final portion is stripped off and
1055 treated as a function. In other words, if there is no file named
1056 F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
1057 to load F<My/Groovy/Producer.pm> and use C<transmogrify> as the name of
1058 the function, instead of the default C<produce>.
1060 my $tr = SQL::Translator->new;
1062 # This will invoke My::Groovy::Producer::produce($tr, $data)
1063 $tr->producer("My::Groovy::Producer");
1065 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
1066 $tr->producer("Sybase");
1068 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
1069 # assuming that My::Groovy::Producer::transmogrify is not a module
1071 $tr->producer("My::Groovy::Producer::transmogrify");
1073 # This will invoke the referenced subroutine directly, as
1074 # $subref->($tr, $data);
1075 $tr->producer(\&my_producer);
1077 There is also a method named C<producer_type>, which is a string
1078 containing the classname to which the above C<produce> function
1079 belongs. In the case of anonymous subroutines, this method returns
1082 Finally, there is a method named C<producer_args>, which is both an
1083 accessor and a mutator. Arbitrary data may be stored in name => value
1084 pairs for the producer subroutine to access:
1086 sub My::Random::producer {
1087 my ($tr, $data) = @_;
1088 my $pr_args = $tr->producer_args();
1090 # $pr_args is a hashref.
1092 Extra data passed to the C<producer> method is passed to
1095 $tr->producer("xSV", delimiter => ',\s*');
1097 # In SQL::Translator::Producer::xSV:
1098 my $args = $tr->producer_args;
1099 my $delimiter = $args->{'delimiter'}; # value is ,\s*
1103 The C<parser> method defines or retrieves a subroutine that will be
1104 called to perform the parsing. The basic idea is the same as that of
1105 C<producer> (see above), except the default subroutine name is
1106 "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
1107 Also, the parser subroutine will be passed a string containing the
1108 entirety of the data to be parsed.
1110 # Invokes SQL::Translator::Parser::MySQL::parse()
1111 $tr->parser("MySQL");
1113 # Invokes My::Groovy::Parser::parse()
1114 $tr->parser("My::Groovy::Parser");
1116 # Invoke an anonymous subroutine directly
1118 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
1119 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
1120 return $dumper->Dump;
1123 There is also C<parser_type> and C<parser_args>, which perform
1124 analogously to C<producer_type> and C<producer_args>
1128 Set or retreive the filters to run over the schema during the
1129 translation, before the producer creates its output. Filters are sub
1130 routines called, in order, with the schema object to filter as the 1st
1131 arg and a hash of options (passed as a list) for the rest of the args.
1132 They are free to do whatever they want to the schema object, which will be
1133 handed to any following filters, then used by the producer.
1135 Filters are set as an array, which gives the order they run in.
1136 Like parsers and producers, they can be defined by a module name, a
1137 module name relative to the SQL::Translator::Filter namespace, a module
1138 name and function name together or a reference to an anonymous subroutine.
1139 When using a module name a function called C<filter> will be invoked in
1140 that package to do the work.
1142 To pass args to the filter set it as an array ref with the 1st value giving
1143 the filter (name or sub) and the rest its args. e.g.
1148 # Do stuff to schema here!
1151 [ "Names", table => 'lc' ],
1152 [ "Foo", foo => "bar", hello => "world" ],
1156 Although you normally set them in the constructor, which calls
1157 through to filters. i.e.
1159 my $translator = SQL::Translator->new(
1163 [ "Names", table => 'lc' ],
1168 See F<t/36-filters.t> for more examples.
1170 Multiple set calls to filters are cumulative with new filters added to
1171 the end of the current list.
1173 Returns the filters as a list of array refs, the 1st value being a
1174 reference to the filter sub and the rest its args.
1176 =head2 show_warnings
1178 Toggles whether to print warnings of name conflicts, identifier
1179 mutations, etc. Probably only generated by producers to let the user
1180 know when something won't translate very smoothly (e.g., MySQL "enum"
1181 fields into Oracle). Accepts a true or false value, returns the
1186 The C<translate> method calls the subroutine referenced by the
1187 C<parser> data member, then calls any C<filters> and finally calls
1188 the C<producer> sub routine (these members are described above).
1189 It accepts as arguments a number of things, in key => value format,
1190 including (potentially) a parser and a producer (they are passed
1191 directly to the C<parser> and C<producer> methods).
1193 Here is how the parameter list to C<translate> is parsed:
1199 1 argument means it's the data to be parsed; which could be a string
1200 (filename) or a reference to a scalar (a string stored in memory), or a
1201 reference to a hash, which is parsed as being more than one argument
1204 # Parse the file /path/to/datafile
1205 my $output = $tr->translate("/path/to/datafile");
1207 # Parse the data contained in the string $data
1208 my $output = $tr->translate(\$data);
1212 More than 1 argument means its a hash of things, and it might be
1213 setting a parser, producer, or datasource (this key is named
1214 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
1216 # As above, parse /path/to/datafile, but with different producers
1217 for my $prod ("MySQL", "XML", "Sybase") {
1218 print $tr->translate(
1220 filename => "/path/to/datafile",
1224 # The filename hash key could also be:
1225 datasource => \$data,
1231 =head2 filename, data
1233 Using the C<filename> method, the filename of the data to be parsed
1234 can be set. This method can be used in conjunction with the C<data>
1235 method, below. If both the C<filename> and C<data> methods are
1236 invoked as mutators, the data set in the C<data> method is used.
1238 $tr->filename("/my/data/files/create.sql");
1242 my $create_script = do {
1244 open CREATE, "/my/data/files/create.sql" or die $!;
1247 $tr->data(\$create_script);
1249 C<filename> takes a string, which is interpreted as a filename.
1250 C<data> takes a reference to a string, which is used as the data to be
1251 parsed. If a filename is set, then that file is opened and read when
1252 the C<translate> method is called, as long as the data instance
1253 variable is not set.
1257 Returns the SQL::Translator::Schema object.
1261 Turns on/off the tracing option of Parse::RecDescent.
1265 Whether or not to validate the schema object after parsing and before
1270 Returns the version of the SQL::Translator release.
1274 The following people have contributed to the SQLFairy project:
1278 =item * Mark Addison <grommit@users.sourceforge.net>
1280 =item * Sam Angiuoli <angiuoli@users.sourceforge.net>
1282 =item * Anders Nor Berle <berle@cpan.org>
1284 =item * Dave Cash <dave@gnofn.org>
1286 =item * Darren Chamberlain <dlc@users.sourceforge.net>
1288 =item * Ken Y. Clark <kclark@cpan.org>
1290 =item * Allen Day <allenday@users.sourceforge.net>
1292 =item * Paul Harrington <phrrngtn@users.sourceforge.net>
1294 =item * Mikey Melillo <mmelillo@users.sourceforge.net>
1296 =item * Chris Mungall <cjm@fruitfly.org>
1298 =item * Ross Smith II <rossta@users.sf.net>
1300 =item * Gudmundur A. Thorisson <mummi@cshl.org>
1302 =item * Chris To <christot@users.sourceforge.net>
1304 =item * Jason Williams <smdwilliams@users.sourceforge.net>
1306 =item * Ying Zhang <zyolive@yahoo.com>
1308 =item * Daniel Ruoso <daniel@ruoso.com>
1310 =item * Ryan D Johnson <ryan@innerfence.com>
1314 If you would like to contribute to the project, you can send patches
1315 to the developers mailing list:
1317 sqlfairy-developers@lists.sourceforge.net
1319 Or send us a message (with your Sourceforge username) asking to be
1320 added to the project and what you'd like to contribute.
1325 This program is free software; you can redistribute it and/or modify
1326 it under the terms of the GNU General Public License as published by
1327 the Free Software Foundation; version 2.
1329 This program is distributed in the hope that it will be useful, but
1330 WITHOUT ANY WARRANTY; without even the implied warranty of
1331 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1332 General Public License for more details.
1334 You should have received a copy of the GNU General Public License
1335 along with this program; if not, write to the Free Software
1336 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
1341 Please use L<http://rt.cpan.org/> for reporting bugs.
1345 If you find this module useful, please use
1346 L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
1351 L<SQL::Translator::Parser>,
1352 L<SQL::Translator::Producer>,
1353 L<Parse::RecDescent>,
1356 L<Text::RecordParser>,