1 package SQL::Translator;
3 # ----------------------------------------------------------------------
4 # $Id: Translator.pm,v 1.61 2004-11-09 05:27:45 grommit Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2002-4 The SQLFairy Authors
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
24 use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR );
25 use base 'Class::Base';
30 $REVISION = sprintf "%d.%02d", q$Revision: 1.61 $ =~ /(\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 # Set the data source, if 'filename' or 'file' is provided.
95 $config->{'filename'} ||= $config->{'file'} || "";
96 $self->filename( $config->{'filename'} ) if $config->{'filename'};
99 # Finally, if there is a 'data' parameter, use that in
100 # preference to filename and file
102 if ( my $data = $config->{'data'} ) {
103 $self->data( $data );
107 # Set various other options.
109 $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
111 $self->add_drop_table( $config->{'add_drop_table'} );
113 $self->no_comments( $config->{'no_comments'} );
115 $self->show_warnings( $config->{'show_warnings'} );
117 $self->trace( $config->{'trace'} );
119 $self->validate( $config->{'validate'} );
124 # ----------------------------------------------------------------------
125 # add_drop_table([$bool])
126 # ----------------------------------------------------------------------
129 if ( defined (my $arg = shift) ) {
130 $self->{'add_drop_table'} = $arg ? 1 : 0;
132 return $self->{'add_drop_table'} || 0;
135 # ----------------------------------------------------------------------
136 # no_comments([$bool])
137 # ----------------------------------------------------------------------
141 if ( defined $arg ) {
142 $self->{'no_comments'} = $arg ? 1 : 0;
144 return $self->{'no_comments'} || 0;
148 # ----------------------------------------------------------------------
149 # producer([$producer_spec])
151 # Get or set the producer for the current translator.
152 # ----------------------------------------------------------------------
156 path => "SQL::Translator::Producer",
157 default_sub => "produce"
161 # ----------------------------------------------------------------------
164 # producer_type is an accessor that allows producer subs to get
165 # information about their origin. This is poptentially important;
166 # since all producer subs are called as subroutine references, there is
167 # no way for a producer to find out which package the sub lives in
168 # originally, for example.
169 # ----------------------------------------------------------------------
170 sub producer_type { $_[0]->{'producer_type'} }
172 # ----------------------------------------------------------------------
173 # producer_args([\%args])
175 # Arbitrary name => value pairs of paramters can be passed to a
176 # producer using this method.
178 # If the first argument passed in is undef, then the hash of arguments
179 # is cleared; all subsequent elements are added to the hash of name,
180 # value pairs stored as producer_args.
181 # ----------------------------------------------------------------------
182 sub producer_args { shift->_args("producer", @_); }
184 # ----------------------------------------------------------------------
185 # parser([$parser_spec])
186 # ----------------------------------------------------------------------
190 path => "SQL::Translator::Parser",
191 default_sub => "parse"
195 sub parser_type { $_[0]->{'parser_type'}; }
197 sub parser_args { shift->_args("parser", @_); }
199 # ----------------------------------------------------------------------
203 if ( defined $arg ) {
204 $self->{'show_warnings'} = $arg ? 1 : 0;
206 return $self->{'show_warnings'} || 0;
210 # filename - get or set the filename
214 my $filename = shift;
216 my $msg = "Cannot use directory '$filename' as input source";
217 return $self->error($msg);
218 } elsif (ref($filename) eq 'ARRAY') {
219 $self->{'filename'} = $filename;
220 $self->debug("Got array of files: ".join(', ',@$filename)."\n");
221 } elsif (-f _ && -r _) {
222 $self->{'filename'} = $filename;
223 $self->debug("Got filename: '$self->{'filename'}'\n");
225 my $msg = "Cannot use '$filename' as input source: ".
226 "file does not exist or is not readable.";
227 return $self->error($msg);
234 # ----------------------------------------------------------------------
237 # if $self->{'data'} is not set, but $self->{'filename'} is, then
238 # $self->{'filename'} is opened and read, with the results put into
240 # ----------------------------------------------------------------------
244 # Set $self->{'data'} based on what was passed in. We will
245 # accept a number of things; do our best to get it right.
248 if (isa($data, "SCALAR")) {
249 $self->{'data'} = $data;
252 if (isa($data, 'ARRAY')) {
253 $data = join '', @$data;
255 elsif (isa($data, 'GLOB')) {
259 elsif (! ref $data && @_) {
260 $data = join '', $data, @_;
262 $self->{'data'} = \$data;
266 # If we have a filename but no data yet, populate.
267 if (not $self->{'data'} and my $filename = $self->filename) {
268 $self->debug("Opening '$filename' to get contents.\n");
273 my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
275 foreach my $file (@files) {
276 unless (open FH, $file) {
277 return $self->error("Can't read file '$file': $!");
283 return $self->error("Can't close file '$file': $!");
287 $self->{'data'} = \$data;
290 return $self->{'data'};
293 # ----------------------------------------------------------------------
296 # Deletes the existing Schema object so that future calls to translate
297 # don't append to the existing.
300 $self->{'schema'} = undef;
304 # ----------------------------------------------------------------------
307 # Returns the SQL::Translator::Schema object
311 unless ( defined $self->{'schema'} ) {
312 $self->{'schema'} = SQL::Translator::Schema->new(
317 return $self->{'schema'};
320 # ----------------------------------------------------------------------
324 if ( defined $arg ) {
325 $self->{'trace'} = $arg ? 1 : 0;
327 return $self->{'trace'} || 0;
330 # ----------------------------------------------------------------------
331 # translate([source], [\%args])
333 # translate does the actual translation. The main argument is the
334 # source of the data to be translated, which can be a filename, scalar
335 # reference, or glob reference.
337 # Alternatively, translate takes optional arguements, which are passed
338 # to the appropriate places. Most notable of these arguments are
339 # parser and producer, which can be used to set the parser and
340 # producer, respectively. This is the applications last chance to set
343 # translate returns a string.
344 # ----------------------------------------------------------------------
347 my ($args, $parser, $parser_type, $producer, $producer_type);
348 my ($parser_output, $producer_output);
352 # Passed a reference to a hash?
353 if (isa($_[0], 'HASH')) {
355 $self->debug("translate: Got a hashref\n");
359 # Passed a GLOB reference, i.e., filehandle
360 elsif (isa($_[0], 'GLOB')) {
361 $self->debug("translate: Got a GLOB reference\n");
365 # Passed a reference to a string containing the data
366 elsif (isa($_[0], 'SCALAR')) {
367 # passed a ref to a string
368 $self->debug("translate: Got a SCALAR reference (string)\n");
372 # Not a reference; treat it as a filename
373 elsif (! ref $_[0]) {
374 # Not a ref, it's a filename
375 $self->debug("translate: Got a filename\n");
376 $self->filename($_[0]);
379 # Passed something else entirely.
381 # We're not impressed. Take your empty string and leave.
384 # Actually, if data, parser, and producer are set, then we
385 # can continue. Too bad, because I like my comment
387 return "" unless ($self->data &&
393 # You must pass in a hash, or you get nothing.
398 # ----------------------------------------------------------------------
399 # Can specify the data to be transformed using "filename", "file",
400 # "data", or "datasource".
401 # ----------------------------------------------------------------------
402 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
403 $self->filename($filename);
406 if (my $data = ($args->{'data'} || $args->{'datasource'})) {
410 # ----------------------------------------------------------------
412 # ----------------------------------------------------------------
413 my $data = $self->data;
415 # ----------------------------------------------------------------
416 # Local reference to the parser subroutine
417 # ----------------------------------------------------------------
418 if ($parser = ($args->{'parser'} || $args->{'from'})) {
419 $self->parser($parser);
421 $parser = $self->parser;
422 $parser_type = $self->parser_type;
424 # ----------------------------------------------------------------
425 # Local reference to the producer subroutine
426 # ----------------------------------------------------------------
427 if ($producer = ($args->{'producer'} || $args->{'to'})) {
428 $self->producer($producer);
430 $producer = $self->producer;
431 $producer_type = $self->producer_type;
433 # ----------------------------------------------------------------
434 # Execute the parser, then execute the producer with that output.
435 # Allowances are made for each piece to die, or fail to compile,
436 # since the referenced subroutines could be almost anything. In
437 # the future, each of these might happen in a Safe environment,
438 # depending on how paranoid we want to be.
439 # ----------------------------------------------------------------
440 unless ( defined $self->{'schema'} ) {
441 eval { $parser_output = $parser->($self, $$data) };
442 if ($@ || ! $parser_output) {
443 my $msg = sprintf "translate: Error with parser '%s': %s",
444 $parser_type, ($@) ? $@ : " no results";
445 return $self->error($msg);
449 $self->debug("Schema =\n", Dumper($self->schema), "\n");
451 if ($self->validate) {
452 my $schema = $self->schema;
453 return $self->error('Invalid schema') unless $schema->is_valid;
456 eval { $producer_output = $producer->($self) };
457 if ($@ || ! $producer_output) {
458 my $err = $@ || $self->error || "no results";
459 my $msg = "translate: Error with producer '$producer_type': $err";
460 return $self->error($msg);
463 return $producer_output;
466 # ----------------------------------------------------------------------
469 # Hacky sort of method to list all available parsers. This has
472 # - Only finds things in the SQL::Translator::Parser namespace
474 # - Only finds things that are located in the same directory
475 # as SQL::Translator::Parser. Yeck.
477 # This method will fail in several very likely cases:
479 # - Parser modules in different namespaces
481 # - Parser modules in the SQL::Translator::Parser namespace that
482 # have any XS componenets will be installed in
483 # arch_lib/SQL/Translator.
485 # ----------------------------------------------------------------------
487 return shift->_list("parser");
490 # ----------------------------------------------------------------------
493 # See notes for list_parsers(), above; all the problems apply to
494 # list_producers as well.
495 # ----------------------------------------------------------------------
497 return shift->_list("producer");
501 # ======================================================================
503 # ======================================================================
505 # ----------------------------------------------------------------------
506 # _args($type, \%args);
508 # Gets or sets ${type}_args. Called by parser_args and producer_args.
509 # ----------------------------------------------------------------------
513 $type = "${type}_args" unless $type =~ /_args$/;
515 unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
516 $self->{$type} = { };
520 # If the first argument is an explicit undef (remember, we
521 # don't get here unless there is stuff in @_), then we clear
522 # out the producer_args hash.
523 if (! defined $_[0]) {
525 %{$self->{$type}} = ();
528 my $args = isa($_[0], 'HASH') ? shift : { @_ };
529 %{$self->{$type}} = (%{$self->{$type}}, %$args);
535 # ----------------------------------------------------------------------
536 # Does the get/set work for parser and producer. e.g.
537 # return $self->_tool({
538 # name => 'producer',
539 # path => "SQL::Translator::Producer",
540 # default_sub => "produce",
542 # ----------------------------------------------------------------------
544 my ($self,$args) = (shift, shift);
545 my $name = $args->{name};
546 return $self->{$name} unless @_; # get accessor
548 my $path = $args->{path};
549 my $default_sub = $args->{default_sub};
552 # passed an anonymous subroutine reference
553 if (isa($tool, 'CODE')) {
554 $self->{$name} = $tool;
555 $self->{"$name\_type"} = "CODE";
556 $self->debug("Got $name: code ref\n");
559 # Module name was passed directly
560 # We try to load the name; if it doesn't load, there's a
561 # possibility that it has a function name attached to it,
562 # so we give it a go.
564 $tool =~ s/-/::/g if $tool !~ /::/;
566 ($code,$sub) = _load_sub("$tool\::$default_sub", $path);
567 ($code,$sub) = _load_sub("$tool", $path) unless $code;
569 # get code reference and assign
570 my (undef,$module,undef) = $sub =~ m/((.*)::)?(\w+)$/;
571 $self->{$name} = $code;
572 $self->{"$name\_type"} = $sub eq "CODE" ? "CODE" : $module;
573 $self->debug("Got $name: $sub\n");
576 # At this point, $self->{$name} contains a subroutine
577 # reference that is ready to run
579 # Anything left? If so, it's args
580 my $meth = "$name\_args";
581 $self->$meth(@_) if (@_);
583 return $self->{$name};
586 # ----------------------------------------------------------------------
588 # ----------------------------------------------------------------------
591 my $type = shift || return ();
592 my $uctype = ucfirst lc $type;
595 # First find all the directories where SQL::Translator
596 # parsers or producers (the "type") appear to live.
598 load("SQL::Translator::$uctype") or return ();
599 my $path = catfile "SQL", "Translator", $uctype;
602 my $dir = catfile $_, $path;
603 $self->debug("_list_${type}s searching $dir\n");
609 # Now use File::File::find to look recursively in those
610 # directories for all the *.pm files, then present them
611 # with the slashes turned into dashes.
616 if ( -f && m/\.pm$/ ) {
619 my $cur_dir = $File::Find::dir;
620 my $base_dir = quotemeta catfile 'SQL', 'Translator', $uctype;
623 # See if the current directory is below the base directory.
625 if ( $cur_dir =~ m/$base_dir(.*)/ ) {
627 $cur_dir =~ s!^/!!; # kill leading slash
628 $cur_dir =~ s!/!-!g; # turn other slashes into dashes
634 $found{ join '-', map { $_ || () } $cur_dir, $mod } = 1;
640 return sort { lc $a cmp lc $b } keys %found;
643 # ----------------------------------------------------------------------
644 # load(MODULE [,PATH[,PATH]...])
646 # Loads a Perl module. Short circuits if a module is already loaded.
648 # MODULE - is the name of the module to load.
650 # PATH - optional list of 'package paths' to look for the module in. e.g
651 # If you called load(Bar => 'Foo', 'My::Modules') it will try to load the mod
652 # Bar then Foo::Bar then My::Modules::Bar.
654 # Returns package name of the module actually loaded or false and sets error.
656 # Note, you can't load a name from the root namespace (ie one without '::' in
657 # it), therefore a single word name without a path fails.
658 # ----------------------------------------------------------------------
662 push @path, "" if $name =~ /::/; # Empty path to check name on its own first
663 push @path, @_ if @_;
666 my $module = $_ ? "$_\::$name" : $name;
667 my $file = $module; $file =~ s[::][/]g; $file .= ".pm";
668 __PACKAGE__->debug("Loading $name as $file\n");
669 return $module if $INC{$file}; # Already loaded
671 eval { require $file };
672 next if $@ =~ /Can't locate $file in \@INC/;
673 eval { $file->import(@_) } unless $@;
674 return __PACKAGE__->error("Error loading $name as $module : $@") if $@;
676 return $module; # Module loaded ok
679 return __PACKAGE__->error("Can't find $name. Path:".join(",",@path));
682 # ----------------------------------------------------------------------
683 # Load the sub name given (including package), optionally using a base package
684 # path. Returns code ref and name of sub loaded, including its package.
685 # (\&code, $sub) = load_sub( 'MySQL::produce', "SQL::Translator::Producer" );
686 # (\&code, $sub) = load_sub( 'MySQL::produce', @path );
687 # ----------------------------------------------------------------------
689 my ($tool, @path) = @_;
691 # Passed a module name or module and sub name
692 my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/;
693 if ( my $module = load($module => @path) ) {
694 my $sub = "$module\::$func_name";
695 return ( \&{ $sub }, $sub );
700 # ----------------------------------------------------------------------
701 sub format_table_name {
702 return shift->_format_name('_format_table_name', @_);
705 # ----------------------------------------------------------------------
706 sub format_package_name {
707 return shift->_format_name('_format_package_name', @_);
710 # ----------------------------------------------------------------------
712 return shift->_format_name('_format_fk_name', @_);
715 # ----------------------------------------------------------------------
717 return shift->_format_name('_format_pk_name', @_);
720 # ----------------------------------------------------------------------
721 # The other format_*_name methods rely on this one. It optionally
722 # accepts a subroutine ref as the first argument (or uses an identity
723 # sub if one isn't provided or it doesn't already exist), and applies
724 # it to the rest of the arguments (if any).
725 # ----------------------------------------------------------------------
731 if (ref($args[0]) eq 'CODE') {
732 $self->{$field} = shift @args;
734 elsif (! exists $self->{$field}) {
735 $self->{$field} = sub { return shift };
738 return @args ? $self->{$field}->(@args) : $self->{$field};
741 # ----------------------------------------------------------------------
744 # Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
745 # but I like function overhead.
746 # ----------------------------------------------------------------------
748 my ($ref, $type) = @_;
749 return UNIVERSAL::isa($ref, $type);
752 # ----------------------------------------------------------------------
755 # Returns the $VERSION of the main SQL::Translator package.
756 # ----------------------------------------------------------------------
762 # ----------------------------------------------------------------------
764 my ( $self, $arg ) = @_;
765 if ( defined $arg ) {
766 $self->{'validate'} = $arg ? 1 : 0;
768 return $self->{'validate'} || 0;
773 # ----------------------------------------------------------------------
774 # Who killed the pork chops?
775 # What price bananas?
778 # ----------------------------------------------------------------------
784 SQL::Translator - manipulate structured data definitions (SQL and more)
790 my $translator = SQL::Translator->new(
793 # Print Parse::RecDescent trace
795 # Don't include comments in output
797 # Print name mutations, conflicts
799 # Add "drop table" statements
801 # Validate schema object
803 # Make all table names CAPS in producers which support this option
804 format_table_name => sub {my $tablename = shift; return uc($tablename)},
805 # Null-op formatting, only here for documentation's sake
806 format_package_name => sub {return shift},
807 format_fk_name => sub {return shift},
808 format_pk_name => sub {return shift},
811 my $output = $translator->translate(
814 # Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
816 ) or die $translator->error;
822 This documentation covers the API for SQL::Translator. For a more general
823 discussion of how to use the modules and scripts, please see
824 L<SQL::Translator::Manual>.
826 SQL::Translator is a group of Perl modules that converts
827 vendor-specific SQL table definitions into other formats, such as
828 other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
829 XML, and Class::DBI classes. The main focus of SQL::Translator is
830 SQL, but parsers exist for other structured data formats, including
831 Excel spreadsheets and arbitrarily delimited text files. Through the
832 separation of the code into parsers and producers with an object model
833 in between, it's possible to combine any parser with any producer, to
834 plug in custom parsers or producers, or to manipulate the parsed data
835 via the built-in object model. Presently only the definition parts of
836 SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
841 The constructor is called C<new>, and accepts a optional hash of options.
892 All options are, well, optional; these attributes can be set via
893 instance methods. Internally, they are; no (non-syntactical)
894 advantage is gained by passing options to the constructor.
898 =head2 add_drop_table
900 Toggles whether or not to add "DROP TABLE" statements just before the
905 Toggles whether to print comments in the output. Accepts a true or false
906 value, returns the current value.
910 The C<producer> method is an accessor/mutator, used to retrieve or
911 define what subroutine is called to produce the output. A subroutine
912 defined as a producer will be invoked as a function (I<not a method>)
913 and passed its container C<SQL::Translator> instance, which it should
914 call the C<schema> method on, to get the C<SQL::Translator::Schema>
915 generated by the parser. It is expected that the function transform the
916 schema structure to a string. The C<SQL::Translator> instance is also useful
917 for informational purposes; for example, the type of the parser can be
918 retrieved using the C<parser_type> method, and the C<error> and
919 C<debug> methods can be called when needed.
921 When defining a producer, one of several things can be passed in: A
922 module name (e.g., C<My::Groovy::Producer>), a module name relative to
923 the C<SQL::Translator::Producer> namespace (e.g., C<MySQL>), a module
924 name and function combination (C<My::Groovy::Producer::transmogrify>),
925 or a reference to an anonymous subroutine. If a full module name is
926 passed in (for the purposes of this method, a string containing "::"
927 is considered to be a module name), it is treated as a package, and a
928 function called "produce" will be invoked: C<$modulename::produce>.
929 If $modulename cannot be loaded, the final portion is stripped off and
930 treated as a function. In other words, if there is no file named
931 F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
932 to load F<My/Groovy/Producer.pm> and use C<transmogrify> as the name of
933 the function, instead of the default C<produce>.
935 my $tr = SQL::Translator->new;
937 # This will invoke My::Groovy::Producer::produce($tr, $data)
938 $tr->producer("My::Groovy::Producer");
940 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
941 $tr->producer("Sybase");
943 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
944 # assuming that My::Groovy::Producer::transmogrify is not a module
946 $tr->producer("My::Groovy::Producer::transmogrify");
948 # This will invoke the referenced subroutine directly, as
949 # $subref->($tr, $data);
950 $tr->producer(\&my_producer);
952 There is also a method named C<producer_type>, which is a string
953 containing the classname to which the above C<produce> function
954 belongs. In the case of anonymous subroutines, this method returns
957 Finally, there is a method named C<producer_args>, which is both an
958 accessor and a mutator. Arbitrary data may be stored in name => value
959 pairs for the producer subroutine to access:
961 sub My::Random::producer {
962 my ($tr, $data) = @_;
963 my $pr_args = $tr->producer_args();
965 # $pr_args is a hashref.
967 Extra data passed to the C<producer> method is passed to
970 $tr->producer("xSV", delimiter => ',\s*');
972 # In SQL::Translator::Producer::xSV:
973 my $args = $tr->producer_args;
974 my $delimiter = $args->{'delimiter'}; # value is ,\s*
978 The C<parser> method defines or retrieves a subroutine that will be
979 called to perform the parsing. The basic idea is the same as that of
980 C<producer> (see above), except the default subroutine name is
981 "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
982 Also, the parser subroutine will be passed a string containing the
983 entirety of the data to be parsed.
985 # Invokes SQL::Translator::Parser::MySQL::parse()
986 $tr->parser("MySQL");
988 # Invokes My::Groovy::Parser::parse()
989 $tr->parser("My::Groovy::Parser");
991 # Invoke an anonymous subroutine directly
993 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
994 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
995 return $dumper->Dump;
998 There is also C<parser_type> and C<parser_args>, which perform
999 analogously to C<producer_type> and C<producer_args>
1001 =head2 show_warnings
1003 Toggles whether to print warnings of name conflicts, identifier
1004 mutations, etc. Probably only generated by producers to let the user
1005 know when something won't translate very smoothly (e.g., MySQL "enum"
1006 fields into Oracle). Accepts a true or false value, returns the
1011 The C<translate> method calls the subroutines referenced by the
1012 C<parser> and C<producer> data members (described above). It accepts
1013 as arguments a number of things, in key => value format, including
1014 (potentially) a parser and a producer (they are passed directly to the
1015 C<parser> and C<producer> methods).
1017 Here is how the parameter list to C<translate> is parsed:
1023 1 argument means it's the data to be parsed; which could be a string
1024 (filename) or a reference to a scalar (a string stored in memory), or a
1025 reference to a hash, which is parsed as being more than one argument
1028 # Parse the file /path/to/datafile
1029 my $output = $tr->translate("/path/to/datafile");
1031 # Parse the data contained in the string $data
1032 my $output = $tr->translate(\$data);
1036 More than 1 argument means its a hash of things, and it might be
1037 setting a parser, producer, or datasource (this key is named
1038 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
1040 # As above, parse /path/to/datafile, but with different producers
1041 for my $prod ("MySQL", "XML", "Sybase") {
1042 print $tr->translate(
1044 filename => "/path/to/datafile",
1048 # The filename hash key could also be:
1049 datasource => \$data,
1055 =head2 filename, data
1057 Using the C<filename> method, the filename of the data to be parsed
1058 can be set. This method can be used in conjunction with the C<data>
1059 method, below. If both the C<filename> and C<data> methods are
1060 invoked as mutators, the data set in the C<data> method is used.
1062 $tr->filename("/my/data/files/create.sql");
1066 my $create_script = do {
1068 open CREATE, "/my/data/files/create.sql" or die $!;
1071 $tr->data(\$create_script);
1073 C<filename> takes a string, which is interpreted as a filename.
1074 C<data> takes a reference to a string, which is used as the data to be
1075 parsed. If a filename is set, then that file is opened and read when
1076 the C<translate> method is called, as long as the data instance
1077 variable is not set.
1081 Returns the SQL::Translator::Schema object.
1085 Turns on/off the tracing option of Parse::RecDescent.
1089 Whether or not to validate the schema object after parsing and before
1094 Returns the version of the SQL::Translator release.
1098 The following people have contributed to the SQLFairy project:
1102 =item * Mark Addison <grommit@users.sourceforge.net>
1104 =item * Sam Angiuoli <angiuoli@users.sourceforge.net>
1106 =item * Dave Cash <dave@gnofn.org>
1108 =item * Darren Chamberlain <dlc@users.sourceforge.net>
1110 =item * Ken Y. Clark <kclark@cpan.org>
1112 =item * Allen Day <allenday@users.sourceforge.net>
1114 =item * Paul Harrington <phrrngtn@users.sourceforge.net>
1116 =item * Mikey Melillo <mmelillo@users.sourceforge.net>
1118 =item * Chris Mungall <cjm@fruitfly.org>
1120 =item * Ross Smith II <rossta@users.sf.net>
1122 =item * Gudmundur A. Thorisson <mummi@cshl.org>
1124 =item * Chris To <christot@users.sourceforge.net>
1126 =item * Jason Williams <smdwilliams@users.sourceforge.net>
1128 =item * Ying Zhang <zyolive@yahoo.com>
1132 If you would like to contribute to the project, you can send patches
1133 to the developers mailing list:
1135 sqlfairy-developers@lists.sourceforge.net
1137 Or send us a message (with your Sourceforge username) asking to be
1138 added to the project and what you'd like to contribute.
1143 This program is free software; you can redistribute it and/or modify
1144 it under the terms of the GNU General Public License as published by
1145 the Free Software Foundation; version 2.
1147 This program is distributed in the hope that it will be useful, but
1148 WITHOUT ANY WARRANTY; without even the implied warranty of
1149 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1150 General Public License for more details.
1152 You should have received a copy of the GNU General Public License
1153 along with this program; if not, write to the Free Software
1154 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
1159 Please use L<http://rt.cpan.org/> for reporting bugs.
1163 If you find this module useful, please use
1164 L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
1169 L<SQL::Translator::Parser>,
1170 L<SQL::Translator::Producer>,
1171 L<Parse::RecDescent>,
1174 L<Text::RecordParser>,