package SQL::Translator;
-# ----------------------------------------------------------------------
-# $Id: Translator.pm,v 1.67 2005-06-08 15:32:51 mwz444 Exp $
-# ----------------------------------------------------------------------
-# Copyright (C) 2002-4 The SQLFairy Authors
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; version 2.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-# 02111-1307 USA
-# -------------------------------------------------------------------
-
-use strict;
-use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR );
-use base 'Class::Base';
+use Moo;
+our ( $DEFAULT_SUB, $DEBUG, $ERROR );
-require 5.004;
-
-$VERSION = '0.07';
-$REVISION = sprintf "%d.%02d", q$Revision: 1.67 $ =~ /(\d+)\.(\d+)/;
+our $VERSION = '1.62';
+$VERSION =~ tr/_//d;
$DEBUG = 0 unless defined $DEBUG;
$ERROR = "";
-use Carp qw(carp);
+use Carp qw(carp croak);
use Data::Dumper;
-use Class::Base;
use File::Find;
use File::Spec::Functions qw(catfile);
use File::Basename qw(dirname);
use IO::Dir;
+use Sub::Quote qw(quote_sub);
+use SQL::Translator::Producer;
use SQL::Translator::Schema;
+use SQL::Translator::Utils qw(throw ex2err carp_ro normalize_quote_options);
-# ----------------------------------------------------------------------
-# The default behavior is to "pass through" values (note that the
-# SQL::Translator instance is the first value ($_[0]), and the stuff
-# to be parsed is the second value ($_[1])
-# ----------------------------------------------------------------------
$DEFAULT_SUB = sub { $_[0]->schema } unless defined $DEFAULT_SUB;
-# ----------------------------------------------------------------------
-# init([ARGS])
-# The constructor.
-#
-# new takes an optional hash of arguments. These arguments may
-# include a parser, specified with the keys "parser" or "from",
-# and a producer, specified with the keys "producer" or "to".
-#
-# The values that can be passed as the parser or producer are
-# given directly to the parser or producer methods, respectively.
-# See the appropriate method description below for details about
-# what each expects/accepts.
-# ----------------------------------------------------------------------
-sub init {
- my ( $self, $config ) = @_;
- #
- # Set the parser and producer.
- #
+with qw(
+ SQL::Translator::Role::Debug
+ SQL::Translator::Role::Error
+ SQL::Translator::Role::BuildArgs
+);
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $self = shift;
+ my $config = $self->$orig(@_);
+
# If a 'parser' or 'from' parameter is passed in, use that as the
# parser; if a 'producer' or 'to' parameter is passed in, use that
# as the producer; both default to $DEFAULT_SUB.
- #
- $self->parser ($config->{'parser'} || $config->{'from'} || $DEFAULT_SUB);
- $self->producer($config->{'producer'} || $config->{'to'} || $DEFAULT_SUB);
-
- #
- # Set up callbacks for formatting of pk,fk,table,package names in producer
- # MOVED TO PRODUCER ARGS
- #
- #$self->format_table_name($config->{'format_table_name'});
- #$self->format_package_name($config->{'format_package_name'});
- #$self->format_fk_name($config->{'format_fk_name'});
- #$self->format_pk_name($config->{'format_pk_name'});
+ $config->{parser} ||= $config->{from} if defined $config->{from};
+ $config->{producer} ||= $config->{to} if defined $config->{to};
- #
- # Set the parser_args and producer_args
- #
- for my $pargs ( qw[ parser_args producer_args ] ) {
- $self->$pargs( $config->{$pargs} ) if defined $config->{ $pargs };
- }
+ $config->{filename} ||= $config->{file} if defined $config->{file};
- #
- # Initialize the filters.
- #
- if ( $config->{filters} && ref $config->{filters} eq "ARRAY" ) {
- $self->filters( @{$config->{filters}} )
- || return $self->error('Error inititializing filters: '.$self->error);
- }
+ my $quote = normalize_quote_options($config);
+ $config->{quote_identifiers} = $quote if defined $quote;
- #
- # Set the data source, if 'filename' or 'file' is provided.
- #
- $config->{'filename'} ||= $config->{'file'} || "";
- $self->filename( $config->{'filename'} ) if $config->{'filename'};
+ return $config;
+};
- #
- # Finally, if there is a 'data' parameter, use that in
- # preference to filename and file
- #
- if ( my $data = $config->{'data'} ) {
- $self->data( $data );
+sub BUILD {
+ my ($self) = @_;
+ # Make sure all the tool-related stuff is set up
+ foreach my $tool (qw(producer parser)) {
+ $self->$tool($self->$tool);
}
+}
- #
- # Set various other options.
- #
- $self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
-
- $self->add_drop_table( $config->{'add_drop_table'} );
-
- $self->no_comments( $config->{'no_comments'} );
-
- $self->show_warnings( $config->{'show_warnings'} );
-
- $self->trace( $config->{'trace'} );
-
- $self->validate( $config->{'validate'} );
-
- return $self;
+has $_ => (
+ is => 'rw',
+ default => quote_sub(q{ 0 }),
+ coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
+) foreach qw(add_drop_table no_comments show_warnings trace validate);
+
+# quote_identifiers is on by default, use a 0-but-true as indicator
+# so we can allow individual producers to change the default
+has quote_identifiers => (
+ is => 'rw',
+ default => quote_sub(q{ '0E0' }),
+ coerce => quote_sub(q{ $_[0] || 0 }),
+);
+
+sub quote_table_names {
+ (@_ > 1 and ($_[1] xor $_[0]->quote_identifiers) )
+ ? croak 'Using quote_table_names as a setter is no longer supported'
+ : $_[0]->quote_identifiers;
}
-# ----------------------------------------------------------------------
-# add_drop_table([$bool])
-# ----------------------------------------------------------------------
-sub add_drop_table {
- my $self = shift;
- if ( defined (my $arg = shift) ) {
- $self->{'add_drop_table'} = $arg ? 1 : 0;
- }
- return $self->{'add_drop_table'} || 0;
+sub quote_field_names {
+ (@_ > 1 and ($_[1] xor $_[0]->quote_identifiers) )
+ ? croak 'Using quote_field_names as a setter is no longer supported'
+ : $_[0]->quote_identifiers;
}
-# ----------------------------------------------------------------------
-# no_comments([$bool])
-# ----------------------------------------------------------------------
-sub no_comments {
- my $self = shift;
- my $arg = shift;
- if ( defined $arg ) {
- $self->{'no_comments'} = $arg ? 1 : 0;
+after quote_identifiers => sub {
+ if (@_ > 1) {
+ # synchronize for old code reaching directly into guts
+ $_[0]->{quote_table_names}
+ = $_[0]->{quote_field_names}
+ = $_[1] ? 1 : 0;
}
- return $self->{'no_comments'} || 0;
-}
+};
+has producer => ( is => 'rw', default => sub { $DEFAULT_SUB } );
-# ----------------------------------------------------------------------
-# producer([$producer_spec])
-#
-# Get or set the producer for the current translator.
-# ----------------------------------------------------------------------
-sub producer {
+around producer => sub {
+ my $orig = shift;
shift->_tool({
- name => 'producer',
- path => "SQL::Translator::Producer",
- default_sub => "produce",
+ orig => $orig,
+ name => 'producer',
+ path => "SQL::Translator::Producer",
+ default_sub => "produce",
}, @_);
-}
+};
-# ----------------------------------------------------------------------
-# producer_type()
-#
-# producer_type is an accessor that allows producer subs to get
-# information about their origin. This is poptentially important;
-# since all producer subs are called as subroutine references, there is
-# no way for a producer to find out which package the sub lives in
-# originally, for example.
-# ----------------------------------------------------------------------
-sub producer_type { $_[0]->{'producer_type'} }
+has producer_type => ( is => 'rwp', init_arg => undef );
-# ----------------------------------------------------------------------
-# producer_args([\%args])
-#
-# Arbitrary name => value pairs of paramters can be passed to a
-# producer using this method.
-#
-# If the first argument passed in is undef, then the hash of arguments
-# is cleared; all subsequent elements are added to the hash of name,
-# value pairs stored as producer_args.
-# ----------------------------------------------------------------------
-sub producer_args { shift->_args("producer", @_); }
+around producer_type => carp_ro('producer_type');
-# ----------------------------------------------------------------------
-# parser([$parser_spec])
-# ----------------------------------------------------------------------
-sub parser {
+has producer_args => ( is => 'rw', default => quote_sub(q{ +{} }) );
+
+around producer_args => sub {
+ my $orig = shift;
+ shift->_args($orig, @_);
+};
+
+has parser => ( is => 'rw', default => sub { $DEFAULT_SUB } );
+
+around parser => sub {
+ my $orig = shift;
shift->_tool({
+ orig => $orig,
name => 'parser',
path => "SQL::Translator::Parser",
default_sub => "parse",
}, @_);
-}
-
-sub parser_type { $_[0]->{'parser_type'}; }
-
-sub parser_args { shift->_args("parser", @_); }
+};
+
+has parser_type => ( is => 'rwp', init_arg => undef );
+
+around parser_type => carp_ro('parser_type');
+
+has parser_args => ( is => 'rw', default => quote_sub(q{ +{} }) );
+
+around parser_args => sub {
+ my $orig = shift;
+ shift->_args($orig, @_);
+};
+
+has filters => (
+ is => 'rw',
+ default => quote_sub(q{ [] }),
+ coerce => sub {
+ my @filters;
+ # Set. Convert args to list of [\&code,@args]
+ foreach (@{$_[0]||[]}) {
+ my ($filt,@args) = ref($_) eq "ARRAY" ? @$_ : $_;
+ if ( isa($filt,"CODE") ) {
+ push @filters, [$filt,@args];
+ next;
+ }
+ else {
+ __PACKAGE__->debug("Adding $filt filter. Args:".Dumper(\@args)."\n") if __PACKAGE__->debugging;
+ $filt = _load_sub("$filt\::filter", "SQL::Translator::Filter")
+ || throw(__PACKAGE__->error);
+ push @filters, [$filt,@args];
+ }
+ }
+ return \@filters;
+ },
+);
-# ----------------------------------------------------------------------
-# e.g.
-# $sqlt->filters => [
-# sub { },
-# [ "NormalizeNames", field => "lc", tabel => "ucfirst" ],
-# [
-# "DataTypeMap",
-# "TEXT" => "BIGTEXT",
-# ],
-# ],
-# ----------------------------------------------------------------------
-sub filters {
+around filters => sub {
+ my $orig = shift;
my $self = shift;
- my $filters = $self->{filters} ||= [];
- return @$filters unless @_;
-
- # Set. Convert args to list of [\&code,\%args]
- foreach (@_) {
- $_ = [$_,{}] if not ref($_) eq "ARRAY";
- my ($name,$args) = @$_;
- if ( isa($name,"CODE") ) {
- push @$filters, $_;
- next;
+ return @{$self->$orig([@{$self->$orig}, @_])} if @_;
+ return @{$self->$orig};
+};
+
+has filename => (
+ is => 'rw',
+ isa => sub {
+ foreach my $filename (ref($_[0]) eq 'ARRAY' ? @{$_[0]} : $_[0]) {
+ if (-d $filename) {
+ throw("Cannot use directory '$filename' as input source");
+ }
+ elsif (not -f _ && -r _) {
+ throw("Cannot use '$filename' as input source: ".
+ "file does not exist or is not readable.");
+ }
}
- else {
- $self->debug("Adding $name filter. Args:".Dumper($args)."\n");
- my $code = _load_sub("$name\::filter", "SQL::Translator::Filter");
- return $self->error(__PACKAGE__->error) unless $code;
- push @$filters, [$code,$args];
+ },
+);
+
+around filename => \&ex2err;
+
+has data => (
+ is => 'rw',
+ builder => 1,
+ lazy => 1,
+ coerce => sub {
+ # Set $self->data based on what was passed in. We will
+ # accept a number of things; do our best to get it right.
+ my $data = shift;
+ if (isa($data, 'ARRAY')) {
+ $data = join '', @$data;
}
- }
- return @$filters;
-}
-
-# ----------------------------------------------------------------------
-sub show_warnings {
- my $self = shift;
- my $arg = shift;
- if ( defined $arg ) {
- $self->{'show_warnings'} = $arg ? 1 : 0;
- }
- return $self->{'show_warnings'} || 0;
-}
-
-
-# filename - get or set the filename
-sub filename {
- my $self = shift;
- if (@_) {
- my $filename = shift;
- if (-d $filename) {
- my $msg = "Cannot use directory '$filename' as input source";
- return $self->error($msg);
- } elsif (ref($filename) eq 'ARRAY') {
- $self->{'filename'} = $filename;
- $self->debug("Got array of files: ".join(', ',@$filename)."\n");
- } elsif (-f _ && -r _) {
- $self->{'filename'} = $filename;
- $self->debug("Got filename: '$self->{'filename'}'\n");
- } else {
- my $msg = "Cannot use '$filename' as input source: ".
- "file does not exist or is not readable.";
- return $self->error($msg);
+ elsif (isa($data, 'GLOB')) {
+ seek ($data, 0, 0) if eof ($data);
+ local $/;
+ $data = <$data>;
}
- }
-
- $self->{'filename'};
-}
+ return isa($data, 'SCALAR') ? $data : \$data;
+ },
+);
-# ----------------------------------------------------------------------
-# data([$data])
-#
-# if $self->{'data'} is not set, but $self->{'filename'} is, then
-# $self->{'filename'} is opened and read, with the results put into
-# $self->{'data'}.
-# ----------------------------------------------------------------------
-sub data {
+around data => sub {
+ my $orig = shift;
my $self = shift;
- # Set $self->{'data'} based on what was passed in. We will
- # accept a number of things; do our best to get it right.
- if (@_) {
- my $data = shift;
- if (isa($data, "SCALAR")) {
- $self->{'data'} = $data;
- }
- else {
- if (isa($data, 'ARRAY')) {
- $data = join '', @$data;
- }
- elsif (isa($data, 'GLOB')) {
- local $/;
- $data = <$data>;
- }
- elsif (! ref $data && @_) {
- $data = join '', $data, @_;
- }
- $self->{'data'} = \$data;
- }
+ if (@_ > 1 && !ref $_[0]) {
+ return $self->$orig(\join('', @_));
+ }
+ elsif (@_) {
+ return $self->$orig(@_);
}
+ return ex2err($orig, $self);
+};
+sub _build_data {
+ my $self = shift;
# If we have a filename but no data yet, populate.
- if (not $self->{'data'} and my $filename = $self->filename) {
+ if (my $filename = $self->filename) {
$self->debug("Opening '$filename' to get contents.\n");
- local *FH;
local $/;
my $data;
my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
foreach my $file (@files) {
- unless (open FH, $file) {
- return $self->error("Can't read file '$file': $!");
- }
+ open my $fh, '<', $file
+ or throw("Can't read file '$file': $!");
- $data .= <FH>;
+ $data .= <$fh>;
- unless (close FH) {
- return $self->error("Can't close file '$file': $!");
- }
+ close $fh or throw("Can't close file '$file': $!");
}
- $self->{'data'} = \$data;
+ return \$data;
}
-
- return $self->{'data'};
-}
-
-# ----------------------------------------------------------------------
-sub reset {
-#
-# Deletes the existing Schema object so that future calls to translate
-# don't append to the existing.
-#
- my $self = shift;
- $self->{'schema'} = undef;
- return 1;
}
-# ----------------------------------------------------------------------
-sub schema {
-#
-# Returns the SQL::Translator::Schema object
-#
- my $self = shift;
-
- unless ( defined $self->{'schema'} ) {
- $self->{'schema'} = SQL::Translator::Schema->new(
- translator => $self,
- );
- }
+has schema => (
+ is => 'lazy',
+ init_arg => undef,
+ clearer => 'reset',
+ predicate => '_has_schema',
+);
- return $self->{'schema'};
-}
+around schema => carp_ro('schema');
-# ----------------------------------------------------------------------
-sub trace {
+around reset => sub {
+ my $orig = shift;
my $self = shift;
- my $arg = shift;
- if ( defined $arg ) {
- $self->{'trace'} = $arg ? 1 : 0;
- }
- return $self->{'trace'} || 0;
-}
+ $self->$orig(@_);
+ return 1
+};
+
+sub _build_schema { SQL::Translator::Schema->new(translator => shift) }
-# ----------------------------------------------------------------------
-# translate([source], [\%args])
-#
-# translate does the actual translation. The main argument is the
-# source of the data to be translated, which can be a filename, scalar
-# reference, or glob reference.
-#
-# Alternatively, translate takes optional arguements, which are passed
-# to the appropriate places. Most notable of these arguments are
-# parser and producer, which can be used to set the parser and
-# producer, respectively. This is the applications last chance to set
-# these.
-#
-# translate returns a string.
-# ----------------------------------------------------------------------
sub translate {
my $self = shift;
my ($args, $parser, $parser_type, $producer, $producer_type);
- my ($parser_output, $producer_output);
+ my ($parser_output, $producer_output, @producer_output);
# Parse arguments
if (@_ == 1) {
# ----------------------------------------------------------------
# Run parser
- unless ( defined $self->{'schema'} ) {
+ unless ( $self->_has_schema ) {
eval { $parser_output = $parser->($self, $$data) };
if ($@ || ! $parser_output) {
my $msg = sprintf "translate: Error with parser '%s': %s",
return $self->error($msg);
}
}
- $self->debug("Schema =\n", Dumper($self->schema), "\n");
+ $self->debug("Schema =\n", Dumper($self->schema), "\n") if $self->debugging;;
# Validate the schema if asked to.
if ($self->validate) {
my $filt_num = 0;
foreach ($self->filters) {
$filt_num++;
- my ($code,$args) = @$_;
- eval { $code->($self->schema, $args) };
+ my ($code,@args) = @$_;
+ eval { $code->($self->schema, @args) };
my $err = $@ || $self->error || 0;
return $self->error("Error with filter $filt_num : $err") if $err;
}
# Run producer
- eval { $producer_output = $producer->($self) };
- if ($@ || ! $producer_output) {
+ # Calling wantarray in the eval no work, wrong scope.
+ my $wantarray = wantarray ? 1 : 0;
+ eval {
+ if ($wantarray) {
+ @producer_output = $producer->($self);
+ } else {
+ $producer_output = $producer->($self);
+ }
+ };
+ if ($@ || !( $producer_output || @producer_output)) {
my $err = $@ || $self->error || "no results";
my $msg = "translate: Error with producer '$producer_type': $err";
return $self->error($msg);
}
- return $producer_output;
+ return wantarray ? @producer_output : $producer_output;
}
-# ----------------------------------------------------------------------
-# list_parsers()
-#
-# Hacky sort of method to list all available parsers. This has
-# several problems:
-#
-# - Only finds things in the SQL::Translator::Parser namespace
-#
-# - Only finds things that are located in the same directory
-# as SQL::Translator::Parser. Yeck.
-#
-# This method will fail in several very likely cases:
-#
-# - Parser modules in different namespaces
-#
-# - Parser modules in the SQL::Translator::Parser namespace that
-# have any XS componenets will be installed in
-# arch_lib/SQL/Translator.
-#
-# ----------------------------------------------------------------------
sub list_parsers {
return shift->_list("parser");
}
-# ----------------------------------------------------------------------
-# list_producers()
-#
-# See notes for list_parsers(), above; all the problems apply to
-# list_producers as well.
-# ----------------------------------------------------------------------
sub list_producers {
return shift->_list("producer");
}
# ----------------------------------------------------------------------
sub _args {
my $self = shift;
- my $type = shift;
- $type = "${type}_args" unless $type =~ /_args$/;
-
- unless (defined $self->{$type} && isa($self->{$type}, 'HASH')) {
- $self->{$type} = { };
- }
+ my $orig = shift;
if (@_) {
# If the first argument is an explicit undef (remember, we
# out the producer_args hash.
if (! defined $_[0]) {
shift @_;
- %{$self->{$type}} = ();
+ $self->$orig({});
}
my $args = isa($_[0], 'HASH') ? shift : { @_ };
- %{$self->{$type}} = (%{$self->{$type}}, %$args);
+ return $self->$orig({ %{$self->$orig}, %$args });
}
- $self->{$type};
+ return $self->$orig;
}
# ----------------------------------------------------------------------
# Does the get/set work for parser and producer. e.g.
-# return $self->_tool({
-# name => 'producer',
+# return $self->_tool({
+# name => 'producer',
# path => "SQL::Translator::Producer",
# default_sub => "produce",
# }, @_);
sub _tool {
my ($self,$args) = (shift, shift);
my $name = $args->{name};
+ my $orig = $args->{orig};
return $self->{$name} unless @_; # get accessor
my $path = $args->{path};
my $default_sub = $args->{default_sub};
my $tool = shift;
-
+
# passed an anonymous subroutine reference
if (isa($tool, 'CODE')) {
- $self->{$name} = $tool;
- $self->{"$name\_type"} = "CODE";
+ $self->$orig($tool);
+ $self->${\"_set_${name}_type"}("CODE");
$self->debug("Got $name: code ref\n");
}
# get code reference and assign
my (undef,$module,undef) = $sub =~ m/((.*)::)?(\w+)$/;
- $self->{$name} = $code;
- $self->{"$name\_type"} = $sub eq "CODE" ? "CODE" : $module;
+ $self->$orig($code);
+ $self->${\"_set_$name\_type"}($sub eq "CODE" ? "CODE" : $module);
$self->debug("Got $name: $sub\n");
}
my $uctype = ucfirst lc $type;
#
- # First find all the directories where SQL::Translator
+ # First find all the directories where SQL::Translator
# parsers or producers (the "type") appear to live.
#
load("SQL::Translator::$uctype") or return ();
}
#
- # Now use File::File::find to look recursively in those
+ # Now use File::File::find to look recursively in those
# directories for all the *.pm files, then present them
# with the slashes turned into dashes.
#
my %found;
- find(
- sub {
+ find(
+ sub {
if ( -f && m/\.pm$/ ) {
my $mod = $_;
$mod =~ s/\.pm$//;
return $module if $INC{$file}; # Already loaded
eval { require $file };
- next if $@ =~ /Can't locate $file in \@INC/;
+ next if $@ =~ /Can't locate $file in \@INC/;
eval { $module->import() } unless $@;
return __PACKAGE__->error("Error loading $name as $module : $@")
if $@ && $@ !~ /"SQL::Translator::Producer" is not exported/;
return undef;
}
-# ----------------------------------------------------------------------
sub format_table_name {
return shift->_format_name('_format_table_name', @_);
}
-# ----------------------------------------------------------------------
sub format_package_name {
return shift->_format_name('_format_package_name', @_);
}
-# ----------------------------------------------------------------------
sub format_fk_name {
return shift->_format_name('_format_fk_name', @_);
}
-# ----------------------------------------------------------------------
sub format_pk_name {
return shift->_format_name('_format_pk_name', @_);
}
return @args ? $self->{$field}->(@args) : $self->{$field};
}
-# ----------------------------------------------------------------------
-# isa($ref, $type)
-#
-# Calls UNIVERSAL::isa($ref, $type). I think UNIVERSAL::isa is ugly,
-# but I like function overhead.
-# ----------------------------------------------------------------------
sub isa($$) {
my ($ref, $type) = @_;
return UNIVERSAL::isa($ref, $type);
}
-# ----------------------------------------------------------------------
-# version
-#
-# Returns the $VERSION of the main SQL::Translator package.
-# ----------------------------------------------------------------------
sub version {
my $self = shift;
return $VERSION;
}
-# ----------------------------------------------------------------------
-sub validate {
- my ( $self, $arg ) = @_;
- if ( defined $arg ) {
- $self->{'validate'} = $arg ? 1 : 0;
- }
- return $self->{'validate'} || 0;
-}
+# Must come after all 'has' declarations
+around new => \&ex2err;
1;
show_warnings => 0,
# Add "drop table" statements
add_drop_table => 1,
+ # to quote or not to quote, thats the question
+ quote_identifiers => 1,
# Validate schema object
validate => 1,
# Make all table names CAPS in producers which support this option
=head1 CONSTRUCTOR
+=head2 new
+
The constructor is called C<new>, and accepts a optional hash of options.
Valid options are:
=item *
+quote_identifiers
+
+=item *
+
+quote_table_names (DEPRECATED)
+
+=item *
+
+quote_field_names (DEPRECATED)
+
+=item *
+
no_comments
=item *
=head2 add_drop_table
-Toggles whether or not to add "DROP TABLE" statements just before the
+Toggles whether or not to add "DROP TABLE" statements just before the
create definitions.
+=head2 quote_identifiers
+
+Toggles whether or not to quote identifiers (table, column, constraint, etc.)
+with a quoting mechanism suitable for the chosen Producer. The default (true)
+is to quote them.
+
+=head2 quote_table_names
+
+DEPRECATED - A legacy proxy to L</quote_identifiers>
+
+=head2 quote_field_names
+
+DEPRECATED - A legacy proxy to L</quote_identifiers>
+
=head2 no_comments
Toggles whether to print comments in the output. Accepts a true or false
define what subroutine is called to produce the output. A subroutine
defined as a producer will be invoked as a function (I<not a method>)
and passed its container C<SQL::Translator> instance, which it should
-call the C<schema> method on, to get the C<SQL::Translator::Schema>
+call the C<schema> method on, to get the C<SQL::Translator::Schema>
generated by the parser. It is expected that the function transform the
-schema structure to a string. The C<SQL::Translator> instance is also useful
+schema structure to a string. The C<SQL::Translator> instance is also useful
for informational purposes; for example, the type of the parser can be
retrieved using the C<parser_type> method, and the C<error> and
C<debug> methods can be called when needed.
=head2 filters
-Set or retreive the filters to run over the schema during the
+Set or retrieve the filters to run over the schema during the
translation, before the producer creates its output. Filters are sub
routines called, in order, with the schema object to filter as the 1st
-arg and a hashref of options as the 2nd. They are free to do whatever
-they want to the schema object, which will be handed to any following
-filters, then used by the producer.
+arg and a hash of options (passed as a list) for the rest of the args.
+They are free to do whatever they want to the schema object, which will be
+handed to any following filters, then used by the producer.
Filters are set as an array, which gives the order they run in.
Like parsers and producers, they can be defined by a module name, a
module name relative to the SQL::Translator::Filter namespace, a module
name and function name together or a reference to an anonymous subroutine.
When using a module name a function called C<filter> will be invoked in
-that package to do the work. To pass args to the filter set it as an array
-ref with the 1st value giving the filter and the rest being a hash of
-args.
+that package to do the work.
+
+To pass args to the filter set it as an array ref with the 1st value giving
+the filter (name or sub) and the rest its args. e.g.
$tr->filters(
sub {
my $schema = shift;
# Do stuff to schema here!
},
- [ "Foo", foo => "bar", hello => "world" ],
- [ "Filter3" ],
+ DropFKeys,
+ [ "Names", table => 'lc' ],
+ [ "Foo", foo => "bar", hello => "world" ],
+ [ "Filter5" ],
);
-Although you would normally set them in the constructor, which calls
+Although you normally set them in the constructor, which calls
through to filters. i.e.
my $translator = SQL::Translator->new(
...
filters => [
sub { ... },
- [ Foo, foo => "bar" ],
+ [ "Names", table => 'lc' ],
],
...
);
the end of the current list.
Returns the filters as a list of array refs, the 1st value being a
-reference to the filter sub routine and the 2nd a hashref its args.
+reference to the filter sub and the rest its args.
=head2 show_warnings
=head1 AUTHORS
-The following people have contributed to the SQLFairy project:
-
-=over 4
+See the included AUTHORS file:
+L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
-=item * Mark Addison <grommit@users.sourceforge.net>
+=head1 GETTING HELP/SUPPORT
-=item * Sam Angiuoli <angiuoli@users.sourceforge.net>
+If you are stuck with a problem or have doubts about a particular
+approach do not hesitate to contact us via any of the following
+options (the list is sorted by "fastest response time"):
-=item * Dave Cash <dave@gnofn.org>
+=over
-=item * Darren Chamberlain <dlc@users.sourceforge.net>
+=item * IRC: irc.perl.org#sql-translator
-=item * Ken Y. Clark <kclark@cpan.org>
+=for html
+<a href="https://chat.mibbit.com/#sql-translator@irc.perl.org">(click for instant chatroom login)</a>
-=item * Allen Day <allenday@users.sourceforge.net>
+=item * Mailing list: L<http://lists.scsys.co.uk/mailman/listinfo/dbix-class>
-=item * Paul Harrington <phrrngtn@users.sourceforge.net>
+=item * RT Bug Tracker: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Translator>
-=item * Mikey Melillo <mmelillo@users.sourceforge.net>
+=back
-=item * Chris Mungall <cjm@fruitfly.org>
+=head1 HOW TO CONTRIBUTE
-=item * Ross Smith II <rossta@users.sf.net>
+Contributions are always welcome, in all usable forms (we especially
+welcome documentation improvements). The delivery methods include git-
+or unified-diff formatted patches, GitHub pull requests, or plain bug
+reports either via RT or the Mailing list. Contributors are generally
+granted access to the official repository after their first several
+patches pass successful review. Don't hesitate to
+L<contact|/GETTING HELP/SUPPORT> us with any further questions you may
+have.
-=item * Gudmundur A. Thorisson <mummi@cshl.org>
+This project is maintained in a git repository. The code and related tools are
+accessible at the following locations:
-=item * Chris To <christot@users.sourceforge.net>
+=over
-=item * Jason Williams <smdwilliams@users.sourceforge.net>
+=item * Official repo: L<git://git.shadowcat.co.uk/dbsrgits/SQL-Translator.git>
-=item * Ying Zhang <zyolive@yahoo.com>
+=item * Official gitweb: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/SQL-Translator.git>
-=back
+=item * GitHub mirror: L<https://github.com/dbsrgits/SQL-Translator>
-If you would like to contribute to the project, you can send patches
-to the developers mailing list:
+=item * Authorized committers: L<ssh://dbsrgits@git.shadowcat.co.uk/sql-translator.git>
- sqlfairy-developers@lists.sourceforge.net
+=item * Travis-CI log: L<https://travis-ci.org/dbsrgits/sql-translator/builds>
-Or send us a message (with your Sourceforge username) asking to be
-added to the project and what you'd like to contribute.
+=for html
+↪ Stable branch CI status: <img src="https://secure.travis-ci.org/dbsrgits/sql-translator.png?branch=master"></img>
+=back
=head1 COPYRIGHT
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; version 2.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-USA
+Copyright 2012 the SQL::Translator authors, as listed in L</AUTHORS>.
-=head1 BUGS
+=head1 LICENSE
-Please use L<http://rt.cpan.org/> for reporting bugs.
+This library is free software and may be distributed under the same terms as
+Perl 5 itself.
=head1 PRAISE
-If you find this module useful, please use
+If you find this module useful, please use
L<http://cpanratings.perl.org/rate/?distribution=SQL-Translator> to rate it.
=head1 SEE ALSO
projects / dbsrgits/SQL-Translator.git / blobdiff