1 package SQL::Translator;
5 our ( $DEFAULT_SUB, $DEBUG, $ERROR );
6 use base 'Class::Base';
10 our $VERSION = '0.11013';
11 $DEBUG = 0 unless defined $DEBUG;
14 use Carp qw(carp croak);
18 use File::Spec::Functions qw(catfile);
19 use File::Basename qw(dirname);
21 use SQL::Translator::Producer;
22 use SQL::Translator::Schema;
24 $DEFAULT_SUB = sub { $_[0]->schema } unless defined $DEFAULT_SUB;
27 my ( $self, $config ) = @_;
29 # Set the parser and producer.
31 # If a 'parser' or 'from' parameter is passed in, use that as the
32 # parser; if a 'producer' or 'to' parameter is passed in, use that
33 # as the producer; both default to $DEFAULT_SUB.
35 $self->parser ($config->{'parser'} || $config->{'from'} || $DEFAULT_SUB);
36 $self->producer($config->{'producer'} || $config->{'to'} || $DEFAULT_SUB);
39 # Set up callbacks for formatting of pk,fk,table,package names in producer
40 # MOVED TO PRODUCER ARGS
42 #$self->format_table_name($config->{'format_table_name'});
43 #$self->format_package_name($config->{'format_package_name'});
44 #$self->format_fk_name($config->{'format_fk_name'});
45 #$self->format_pk_name($config->{'format_pk_name'});
48 # Set the parser_args and producer_args
50 for my $pargs ( qw[ parser_args producer_args ] ) {
51 $self->$pargs( $config->{$pargs} ) if defined $config->{ $pargs };
55 # Initialize the filters.
57 if ( $config->{filters} && ref $config->{filters} eq "ARRAY" ) {
58 $self->filters( @{$config->{filters}} )
59 || return $self->error('Error inititializing filters: '.$self->error);
63 # Set the data source, if 'filename' or 'file' is provided.
65 $config->{'filename'} ||= $config->{'file'} || "";
66 $self->filename( $config->{'filename'} ) if $config->{'filename'};
69 # Finally, if there is a 'data' parameter, use that in
70 # preference to filename and file
72 if ( my $data = $config->{'data'} ) {
77 # Set various other options.
79 $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
81 $self->add_drop_table( $config->{'add_drop_table'} );
83 $self->no_comments( $config->{'no_comments'} );
85 $self->show_warnings( $config->{'show_warnings'} );
87 $self->trace( $config->{'trace'} );
89 $self->validate( $config->{'validate'} );
92 if (defined $config->{quote_identifiers}) {
93 $quote = $config->{quote_identifiers};
95 for (qw/quote_table_names quote_field_names/) {
96 carp "Ignoring deprecated parameter '$_', since 'quote_identifiers' is supplied"
97 if defined $config->{$_}
100 # Legacy one set the other is not
102 defined $config->{'quote_table_names'}
104 defined $config->{'quote_field_names'}
106 if (defined $config->{'quote_table_names'}) {
107 carp "Explicitly disabling the deprecated 'quote_table_names' implies disabling 'quote_identifiers' which in turn implies disabling 'quote_field_names'"
108 unless $config->{'quote_table_names'};
109 $quote = $config->{'quote_table_names'} ? 1 : 0;
112 carp "Explicitly disabling the deprecated 'quote_field_names' implies disabling 'quote_identifiers' which in turn implies disabling 'quote_table_names'"
113 unless $config->{'quote_field_names'};
114 $quote = $config->{'quote_field_names'} ? 1 : 0;
117 # Legacy both are set
118 elsif(defined $config->{'quote_table_names'}) {
119 croak 'Setting quote_table_names and quote_field_names to conflicting values is no longer supported'
120 if ($config->{'quote_table_names'} xor $config->{'quote_field_names'});
122 $quote = $config->{'quote_table_names'} ? 1 : 0;
124 # none are set - on by default, use a 0-but-true as indicator
125 # so we can allow individual producers to change the default
130 $self->quote_identifiers($quote);
137 if ( defined (my $arg = shift) ) {
138 $self->{'add_drop_table'} = $arg ? 1 : 0;
140 return $self->{'add_drop_table'} || 0;
146 if ( defined $arg ) {
147 $self->{'no_comments'} = $arg ? 1 : 0;
149 return $self->{'no_comments'} || 0;
152 sub quote_table_names {
153 (@_ > 1 and ($_[1] xor $_[0]->{quote_identifiers}) )
154 ? croak 'Using quote_table_names as a setter is no longer supported'
155 : $_[0]->{quote_identifiers} ? 1 : 0
158 sub quote_field_names {
159 (@_ > 1 and ($_[1] xor $_[0]->{quote_identifiers}) )
160 ? croak 'Using quote_field_names as a setter is no longer supported'
161 : $_[0]->{quote_identifiers} ? 1 : 0
164 sub quote_identifiers {
166 ? # synchronize for old code reaching directly into guts
167 $_[0]->{quote_table_names}
168 = $_[0]->{quote_field_names}
169 = $_[0]->{quote_identifiers}
171 : $_[0]->{quote_identifiers}
177 path => "SQL::Translator::Producer",
178 default_sub => "produce",
182 sub producer_type { $_[0]->{'producer_type'} }
184 sub producer_args { shift->_args("producer", @_); }
189 path => "SQL::Translator::Parser",
190 default_sub => "parse",
194 sub parser_type { $_[0]->{'parser_type'}; }
196 sub parser_args { shift->_args("parser", @_); }
200 my $filters = $self->{filters} ||= [];
201 return @$filters unless @_;
203 # Set. Convert args to list of [\&code,@args]
205 my ($filt,@args) = ref($_) eq "ARRAY" ? @$_ : $_;
206 if ( isa($filt,"CODE") ) {
207 push @$filters, [$filt,@args];
211 $self->debug("Adding $filt filter. Args:".Dumper(\@args)."\n");
212 $filt = _load_sub("$filt\::filter", "SQL::Translator::Filter")
213 || return $self->error(__PACKAGE__->error);
214 push @$filters, [$filt,@args];
223 if ( defined $arg ) {
224 $self->{'show_warnings'} = $arg ? 1 : 0;
226 return $self->{'show_warnings'} || 0;
233 my $filename = shift;
235 my $msg = "Cannot use directory '$filename' as input source";
236 return $self->error($msg);
237 } elsif (ref($filename) eq 'ARRAY') {
238 $self->{'filename'} = $filename;
239 $self->debug("Got array of files: ".join(', ',@$filename)."\n");
240 } elsif (-f _ && -r _) {
241 $self->{'filename'} = $filename;
242 $self->debug("Got filename: '$self->{'filename'}'\n");
244 my $msg = "Cannot use '$filename' as input source: ".
245 "file does not exist or is not readable.";
246 return $self->error($msg);
256 # Set $self->{'data'} based on what was passed in. We will
257 # accept a number of things; do our best to get it right.
260 if (isa($data, "SCALAR")) {
261 $self->{'data'} = $data;
264 if (isa($data, 'ARRAY')) {
265 $data = join '', @$data;
267 elsif (isa($data, 'GLOB')) {
268 seek ($data, 0, 0) if eof ($data);
272 elsif (! ref $data && @_) {
273 $data = join '', $data, @_;
275 $self->{'data'} = \$data;
279 # If we have a filename but no data yet, populate.
280 if (not $self->{'data'} and my $filename = $self->filename) {
281 $self->debug("Opening '$filename' to get contents.\n");
286 my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
288 foreach my $file (@files) {
289 unless (open FH, $file) {
290 return $self->error("Can't read file '$file': $!");
296 return $self->error("Can't close file '$file': $!");
300 $self->{'data'} = \$data;
303 return $self->{'data'};
308 # Deletes the existing Schema object so that future calls to translate
309 # don't append to the existing.
312 $self->{'schema'} = undef;
318 # Returns the SQL::Translator::Schema object
322 unless ( defined $self->{'schema'} ) {
323 $self->{'schema'} = SQL::Translator::Schema->new(
328 return $self->{'schema'};
334 if ( defined $arg ) {
335 $self->{'trace'} = $arg ? 1 : 0;
337 return $self->{'trace'} || 0;
342 my ($args, $parser, $parser_type, $producer, $producer_type);
343 my ($parser_output, $producer_output, @producer_output);
347 # Passed a reference to a hash?
348 if (isa($_[0], 'HASH')) {
350 $self->debug("translate: Got a hashref\n");
354 # Passed a GLOB reference, i.e., filehandle
355 elsif (isa($_[0], 'GLOB')) {
356 $self->debug("translate: Got a GLOB reference\n");
360 # Passed a reference to a string containing the data
361 elsif (isa($_[0], 'SCALAR')) {
362 # passed a ref to a string
363 $self->debug("translate: Got a SCALAR reference (string)\n");
367 # Not a reference; treat it as a filename
368 elsif (! ref $_[0]) {
369 # Not a ref, it's a filename
370 $self->debug("translate: Got a filename\n");
371 $self->filename($_[0]);
374 # Passed something else entirely.
376 # We're not impressed. Take your empty string and leave.
379 # Actually, if data, parser, and producer are set, then we
380 # can continue. Too bad, because I like my comment
382 return "" unless ($self->data &&
388 # You must pass in a hash, or you get nothing.
393 # ----------------------------------------------------------------------
394 # Can specify the data to be transformed using "filename", "file",
395 # "data", or "datasource".
396 # ----------------------------------------------------------------------
397 if (my $filename = ($args->{'filename'} || $args->{'file'})) {
398 $self->filename($filename);
401 if (my $data = ($args->{'data'} || $args->{'datasource'})) {
405 # ----------------------------------------------------------------
407 # ----------------------------------------------------------------
408 my $data = $self->data;
410 # ----------------------------------------------------------------
411 # Local reference to the parser subroutine
412 # ----------------------------------------------------------------
413 if ($parser = ($args->{'parser'} || $args->{'from'})) {
414 $self->parser($parser);
416 $parser = $self->parser;
417 $parser_type = $self->parser_type;
419 # ----------------------------------------------------------------
420 # Local reference to the producer subroutine
421 # ----------------------------------------------------------------
422 if ($producer = ($args->{'producer'} || $args->{'to'})) {
423 $self->producer($producer);
425 $producer = $self->producer;
426 $producer_type = $self->producer_type;
428 # ----------------------------------------------------------------
429 # Execute the parser, the filters and then execute the producer.
430 # Allowances are made for each piece to die, or fail to compile,
431 # since the referenced subroutines could be almost anything. In
432 # the future, each of these might happen in a Safe environment,
433 # depending on how paranoid we want to be.
434 # ----------------------------------------------------------------
437 unless ( defined $self->{'schema'} ) {
438 eval { $parser_output = $parser->($self, $$data) };
439 if ($@ || ! $parser_output) {
440 my $msg = sprintf "translate: Error with parser '%s': %s",
441 $parser_type, ($@) ? $@ : " no results";
442 return $self->error($msg);
445 $self->debug("Schema =\n", Dumper($self->schema), "\n");
447 # Validate the schema if asked to.
448 if ($self->validate) {
449 my $schema = $self->schema;
450 return $self->error('Invalid schema') unless $schema->is_valid;
455 foreach ($self->filters) {
457 my ($code,@args) = @$_;
458 eval { $code->($self->schema, @args) };
459 my $err = $@ || $self->error || 0;
460 return $self->error("Error with filter $filt_num : $err") if $err;
464 # Calling wantarray in the eval no work, wrong scope.
465 my $wantarray = wantarray ? 1 : 0;
468 @producer_output = $producer->($self);
470 $producer_output = $producer->($self);
473 if ($@ || !( $producer_output || @producer_output)) {
474 my $err = $@ || $self->error || "no results";
475 my $msg = "translate: Error with producer '$producer_type': $err";
476 return $self->error($msg);
479 return wantarray ? @producer_output : $producer_output;
483 return shift->_list("parser");
487 return shift->_list("producer");
491 # ======================================================================
493 # ======================================================================
495 # ----------------------------------------------------------------------
496 # _args($type, \%args);
498 # Gets or sets ${type}_args. Called by parser_args and producer_args.
499 # ----------------------------------------------------------------------
503 $type = "${type}_args" unless $type =~ /_args$/;
505 unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
506 $self->{$type} = { };
510 # If the first argument is an explicit undef (remember, we
511 # don't get here unless there is stuff in @_), then we clear
512 # out the producer_args hash.
513 if (! defined $_[0]) {
515 %{$self->{$type}} = ();
518 my $args = isa($_[0], 'HASH') ? shift : { @_ };
519 %{$self->{$type}} = (%{$self->{$type}}, %$args);
525 # ----------------------------------------------------------------------
526 # Does the get/set work for parser and producer. e.g.
527 # return $self->_tool({
528 # name => 'producer',
529 # path => "SQL::Translator::Producer",
530 # default_sub => "produce",
532 # ----------------------------------------------------------------------
534 my ($self,$args) = (shift, shift);
535 my $name = $args->{name};
536 return $self->{$name} unless @_; # get accessor
538 my $path = $args->{path};
539 my $default_sub = $args->{default_sub};
542 # passed an anonymous subroutine reference
543 if (isa($tool, 'CODE')) {
544 $self->{$name} = $tool;
545 $self->{"$name\_type"} = "CODE";
546 $self->debug("Got $name: code ref\n");
549 # Module name was passed directly
550 # We try to load the name; if it doesn't load, there's a
551 # possibility that it has a function name attached to it,
552 # so we give it a go.
554 $tool =~ s/-/::/g if $tool !~ /::/;
556 ($code,$sub) = _load_sub("$tool\::$default_sub", $path);
558 if ( __PACKAGE__->error =~ m/Can't find module/ ) {
559 # Mod not found so try sub
560 ($code,$sub) = _load_sub("$tool", $path) unless $code;
561 die "Can't load $name subroutine '$tool' : ".__PACKAGE__->error
565 die "Can't load $name '$tool' : ".__PACKAGE__->error;
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('Super::Foo' => 'My', 'Other') it will
652 # try to load the mod Super::Foo then My::Super::Foo then Other::Super::Foo.
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 { $module->import() } unless $@;
674 return __PACKAGE__->error("Error loading $name as $module : $@")
675 if $@ && $@ !~ /"SQL::Translator::Producer" is not exported/;
677 return $module; # Module loaded ok
680 return __PACKAGE__->error("Can't find module $name. Path:".join(",",@path));
683 # ----------------------------------------------------------------------
684 # Load the sub name given (including package), optionally using a base package
685 # path. Returns code ref and name of sub loaded, including its package.
686 # (\&code, $sub) = load_sub( 'MySQL::produce', "SQL::Translator::Producer" );
687 # (\&code, $sub) = load_sub( 'MySQL::produce', @path );
688 # ----------------------------------------------------------------------
690 my ($tool, @path) = @_;
692 my (undef,$module,$func_name) = $tool =~ m/((.*)::)?(\w+)$/;
693 if ( my $module = load($module => @path) ) {
694 my $sub = "$module\::$func_name";
695 return wantarray ? ( \&{ $sub }, $sub ) : \&$sub;
700 sub format_table_name {
701 return shift->_format_name('_format_table_name', @_);
704 sub format_package_name {
705 return shift->_format_name('_format_package_name', @_);
709 return shift->_format_name('_format_fk_name', @_);
713 return shift->_format_name('_format_pk_name', @_);
716 # ----------------------------------------------------------------------
717 # The other format_*_name methods rely on this one. It optionally
718 # accepts a subroutine ref as the first argument (or uses an identity
719 # sub if one isn't provided or it doesn't already exist), and applies
720 # it to the rest of the arguments (if any).
721 # ----------------------------------------------------------------------
727 if (ref($args[0]) eq 'CODE') {
728 $self->{$field} = shift @args;
730 elsif (! exists $self->{$field}) {
731 $self->{$field} = sub { return shift };
734 return @args ? $self->{$field}->(@args) : $self->{$field};
738 my ($ref, $type) = @_;
739 return UNIVERSAL::isa($ref, $type);
748 my ( $self, $arg ) = @_;
749 if ( defined $arg ) {
750 $self->{'validate'} = $arg ? 1 : 0;
752 return $self->{'validate'} || 0;
757 # ----------------------------------------------------------------------
758 # Who killed the pork chops?
759 # What price bananas?
762 # ----------------------------------------------------------------------
768 SQL::Translator - manipulate structured data definitions (SQL and more)
774 my $translator = SQL::Translator->new(
777 # Print Parse::RecDescent trace
779 # Don't include comments in output
781 # Print name mutations, conflicts
783 # Add "drop table" statements
785 # to quote or not to quote, thats the question
786 quote_identifiers => 1,
787 # Validate schema object
789 # Make all table names CAPS in producers which support this option
790 format_table_name => sub {my $tablename = shift; return uc($tablename)},
791 # Null-op formatting, only here for documentation's sake
792 format_package_name => sub {return shift},
793 format_fk_name => sub {return shift},
794 format_pk_name => sub {return shift},
797 my $output = $translator->translate(
800 # Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
802 ) or die $translator->error;
808 This documentation covers the API for SQL::Translator. For a more general
809 discussion of how to use the modules and scripts, please see
810 L<SQL::Translator::Manual>.
812 SQL::Translator is a group of Perl modules that converts
813 vendor-specific SQL table definitions into other formats, such as
814 other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
815 XML, and Class::DBI classes. The main focus of SQL::Translator is
816 SQL, but parsers exist for other structured data formats, including
817 Excel spreadsheets and arbitrarily delimited text files. Through the
818 separation of the code into parsers and producers with an object model
819 in between, it's possible to combine any parser with any producer, to
820 plug in custom parsers or producers, or to manipulate the parsed data
821 via the built-in object model. Presently only the definition parts of
822 SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
827 The constructor is called C<new>, and accepts a optional hash of options.
874 quote_table_names (DEPRECATED)
878 quote_field_names (DEPRECATED)
894 All options are, well, optional; these attributes can be set via
895 instance methods. Internally, they are; no (non-syntactical)
896 advantage is gained by passing options to the constructor.
900 =head2 add_drop_table
902 Toggles whether or not to add "DROP TABLE" statements just before the
905 =head2 quote_identifiers
907 Toggles whether or not to quote identifiers (table, column, constraint, etc.)
908 with a quoting mechanism suitable for the chosen Producer. The default (true)
911 =head2 quote_table_names
913 DEPRECATED - A legacy proxy to L</quote_identifiers>
915 =head2 quote_field_names
917 DEPRECATED - A legacy proxy to L</quote_identifiers>
921 Toggles whether to print comments in the output. Accepts a true or false
922 value, returns the current value.
926 The C<producer> method is an accessor/mutator, used to retrieve or
927 define what subroutine is called to produce the output. A subroutine
928 defined as a producer will be invoked as a function (I<not a method>)
929 and passed its container C<SQL::Translator> instance, which it should
930 call the C<schema> method on, to get the C<SQL::Translator::Schema>
931 generated by the parser. It is expected that the function transform the
932 schema structure to a string. The C<SQL::Translator> instance is also useful
933 for informational purposes; for example, the type of the parser can be
934 retrieved using the C<parser_type> method, and the C<error> and
935 C<debug> methods can be called when needed.
937 When defining a producer, one of several things can be passed in: A
938 module name (e.g., C<My::Groovy::Producer>), a module name relative to
939 the C<SQL::Translator::Producer> namespace (e.g., C<MySQL>), a module
940 name and function combination (C<My::Groovy::Producer::transmogrify>),
941 or a reference to an anonymous subroutine. If a full module name is
942 passed in (for the purposes of this method, a string containing "::"
943 is considered to be a module name), it is treated as a package, and a
944 function called "produce" will be invoked: C<$modulename::produce>.
945 If $modulename cannot be loaded, the final portion is stripped off and
946 treated as a function. In other words, if there is no file named
947 F<My/Groovy/Producer/transmogrify.pm>, C<SQL::Translator> will attempt
948 to load F<My/Groovy/Producer.pm> and use C<transmogrify> as the name of
949 the function, instead of the default C<produce>.
951 my $tr = SQL::Translator->new;
953 # This will invoke My::Groovy::Producer::produce($tr, $data)
954 $tr->producer("My::Groovy::Producer");
956 # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
957 $tr->producer("Sybase");
959 # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
960 # assuming that My::Groovy::Producer::transmogrify is not a module
962 $tr->producer("My::Groovy::Producer::transmogrify");
964 # This will invoke the referenced subroutine directly, as
965 # $subref->($tr, $data);
966 $tr->producer(\&my_producer);
968 There is also a method named C<producer_type>, which is a string
969 containing the classname to which the above C<produce> function
970 belongs. In the case of anonymous subroutines, this method returns
973 Finally, there is a method named C<producer_args>, which is both an
974 accessor and a mutator. Arbitrary data may be stored in name => value
975 pairs for the producer subroutine to access:
977 sub My::Random::producer {
978 my ($tr, $data) = @_;
979 my $pr_args = $tr->producer_args();
981 # $pr_args is a hashref.
983 Extra data passed to the C<producer> method is passed to
986 $tr->producer("xSV", delimiter => ',\s*');
988 # In SQL::Translator::Producer::xSV:
989 my $args = $tr->producer_args;
990 my $delimiter = $args->{'delimiter'}; # value is ,\s*
994 The C<parser> method defines or retrieves a subroutine that will be
995 called to perform the parsing. The basic idea is the same as that of
996 C<producer> (see above), except the default subroutine name is
997 "parse", and will be invoked as C<$module_name::parse($tr, $data)>.
998 Also, the parser subroutine will be passed a string containing the
999 entirety of the data to be parsed.
1001 # Invokes SQL::Translator::Parser::MySQL::parse()
1002 $tr->parser("MySQL");
1004 # Invokes My::Groovy::Parser::parse()
1005 $tr->parser("My::Groovy::Parser");
1007 # Invoke an anonymous subroutine directly
1009 my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
1010 $dumper->Purity(1)->Terse(1)->Deepcopy(1);
1011 return $dumper->Dump;
1014 There is also C<parser_type> and C<parser_args>, which perform
1015 analogously to C<producer_type> and C<producer_args>
1019 Set or retreive the filters to run over the schema during the
1020 translation, before the producer creates its output. Filters are sub
1021 routines called, in order, with the schema object to filter as the 1st
1022 arg and a hash of options (passed as a list) for the rest of the args.
1023 They are free to do whatever they want to the schema object, which will be
1024 handed to any following filters, then used by the producer.
1026 Filters are set as an array, which gives the order they run in.
1027 Like parsers and producers, they can be defined by a module name, a
1028 module name relative to the SQL::Translator::Filter namespace, a module
1029 name and function name together or a reference to an anonymous subroutine.
1030 When using a module name a function called C<filter> will be invoked in
1031 that package to do the work.
1033 To pass args to the filter set it as an array ref with the 1st value giving
1034 the filter (name or sub) and the rest its args. e.g.
1039 # Do stuff to schema here!
1042 [ "Names", table => 'lc' ],
1043 [ "Foo", foo => "bar", hello => "world" ],
1047 Although you normally set them in the constructor, which calls
1048 through to filters. i.e.
1050 my $translator = SQL::Translator->new(
1054 [ "Names", table => 'lc' ],
1059 See F<t/36-filters.t> for more examples.
1061 Multiple set calls to filters are cumulative with new filters added to
1062 the end of the current list.
1064 Returns the filters as a list of array refs, the 1st value being a
1065 reference to the filter sub and the rest its args.
1067 =head2 show_warnings
1069 Toggles whether to print warnings of name conflicts, identifier
1070 mutations, etc. Probably only generated by producers to let the user
1071 know when something won't translate very smoothly (e.g., MySQL "enum"
1072 fields into Oracle). Accepts a true or false value, returns the
1077 The C<translate> method calls the subroutine referenced by the
1078 C<parser> data member, then calls any C<filters> and finally calls
1079 the C<producer> sub routine (these members are described above).
1080 It accepts as arguments a number of things, in key => value format,
1081 including (potentially) a parser and a producer (they are passed
1082 directly to the C<parser> and C<producer> methods).
1084 Here is how the parameter list to C<translate> is parsed:
1090 1 argument means it's the data to be parsed; which could be a string
1091 (filename) or a reference to a scalar (a string stored in memory), or a
1092 reference to a hash, which is parsed as being more than one argument
1095 # Parse the file /path/to/datafile
1096 my $output = $tr->translate("/path/to/datafile");
1098 # Parse the data contained in the string $data
1099 my $output = $tr->translate(\$data);
1103 More than 1 argument means its a hash of things, and it might be
1104 setting a parser, producer, or datasource (this key is named
1105 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
1107 # As above, parse /path/to/datafile, but with different producers
1108 for my $prod ("MySQL", "XML", "Sybase") {
1109 print $tr->translate(
1111 filename => "/path/to/datafile",
1115 # The filename hash key could also be:
1116 datasource => \$data,
1122 =head2 filename, data
1124 Using the C<filename> method, the filename of the data to be parsed
1125 can be set. This method can be used in conjunction with the C<data>
1126 method, below. If both the C<filename> and C<data> methods are
1127 invoked as mutators, the data set in the C<data> method is used.
1129 $tr->filename("/my/data/files/create.sql");
1133 my $create_script = do {
1135 open CREATE, "/my/data/files/create.sql" or die $!;
1138 $tr->data(\$create_script);
1140 C<filename> takes a string, which is interpreted as a filename.
1141 C<data> takes a reference to a string, which is used as the data to be
1142 parsed. If a filename is set, then that file is opened and read when
1143 the C<translate> method is called, as long as the data instance
1144 variable is not set.
1148 Returns the SQL::Translator::Schema object.
1152 Turns on/off the tracing option of Parse::RecDescent.
1156 Whether or not to validate the schema object after parsing and before
1161 Returns the version of the SQL::Translator release.
1165 See the included AUTHORS file:
1166 L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
1168 If you would like to contribute to the project, you can send patches
1169 to the developers mailing list:
1171 sqlfairy-developers@lists.sourceforge.net
1173 Or send us a message (with your Sourceforge username) asking to be
1174 added to the project and what you'd like to contribute.
1179 This program is free software; you can redistribute it and/or modify
1180 it under the terms of the GNU General Public License as published by
1181 the Free Software Foundation; version 2.
1183 This program is distributed in the hope that it will be useful, but
1184 WITHOUT ANY WARRANTY; without even the implied warranty of
1185 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1186 General Public License for more details.
1188 You should have received a copy of the GNU General Public License
1189 along with this program; if not, write to the Free Software
1190 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
1195 Please use L<http://rt.cpan.org/> for reporting bugs.
1199 If you find this module useful, please use
1200 L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
1205 L<SQL::Translator::Parser>,
1206 L<SQL::Translator::Producer>,
1207 L<Parse::RecDescent>,
1210 L<Text::RecordParser>,