X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator.pm;h=0402fd0f50f3978291b56d99433a0f78aaf7903f;hb=df399712c8e458cbd2bf0389cb17666ce499dedd;hp=88df169fda1895da33ef9b7d13f3dc5945e89359;hpb=f51d8e46726ee4701607dbe0429b70fe6c41eefb;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 88df169..0402fd0 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,66 +1,27 @@ package SQL::Translator; -# ---------------------------------------------------------------------- -# $Id: Translator.pm,v 1.72 2007-09-26 13:20:09 schiffbruechige 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 vars qw( $VERSION $DEFAULT_SUB $DEBUG $ERROR ); use base 'Class::Base'; -require 5.004; +require 5.005; -$VERSION = '0.08001'; -$REVISION = sprintf "%d.%02d", q$Revision: 1.72 $ =~ /(\d+)\.(\d+)/; +$VERSION = '0.11010'; $DEBUG = 0 unless defined $DEBUG; $ERROR = ""; use Carp qw(carp); use Data::Dumper; -use Class::Base; use File::Find; use File::Spec::Functions qw(catfile); use File::Basename qw(dirname); use IO::Dir; +use SQL::Translator::Producer; use SQL::Translator::Schema; -# ---------------------------------------------------------------------- -# 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 ) = @_; # @@ -125,18 +86,15 @@ sub init { $self->trace( $config->{'trace'} ); $self->validate( $config->{'validate'} ); - - $self->quote_table_names( (defined $config->{'quote_table_names'} + + $self->quote_table_names( (defined $config->{'quote_table_names'} ? $config->{'quote_table_names'} : 1) ); - $self->quote_field_names( (defined $config->{'quote_field_names'} + $self->quote_field_names( (defined $config->{'quote_field_names'} ? $config->{'quote_field_names'} : 1) ); return $self; } -# ---------------------------------------------------------------------- -# add_drop_table([$bool]) -# ---------------------------------------------------------------------- sub add_drop_table { my $self = shift; if ( defined (my $arg = shift) ) { @@ -145,9 +103,6 @@ sub add_drop_table { return $self->{'add_drop_table'} || 0; } -# ---------------------------------------------------------------------- -# no_comments([$bool]) -# ---------------------------------------------------------------------- sub no_comments { my $self = shift; my $arg = shift; @@ -157,10 +112,6 @@ sub no_comments { return $self->{'no_comments'} || 0; } - -# ---------------------------------------------------------------------- -# quote_table_names([$bool]) -# ---------------------------------------------------------------------- sub quote_table_names { my $self = shift; if ( defined (my $arg = shift) ) { @@ -169,9 +120,6 @@ sub quote_table_names { return $self->{'quote_table_names'} || 0; } -# ---------------------------------------------------------------------- -# quote_field_names([$bool]) -# ---------------------------------------------------------------------- sub quote_field_names { my $self = shift; if ( defined (my $arg = shift) ) { @@ -180,11 +128,6 @@ sub quote_field_names { return $self->{'quote_field_names'} || 0; } -# ---------------------------------------------------------------------- -# producer([$producer_spec]) -# -# Get or set the producer for the current translator. -# ---------------------------------------------------------------------- sub producer { shift->_tool({ name => 'producer', @@ -193,32 +136,10 @@ sub producer { }, @_); } -# ---------------------------------------------------------------------- -# 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'} } -# ---------------------------------------------------------------------- -# 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", @_); } -# ---------------------------------------------------------------------- -# parser([$parser_spec]) -# ---------------------------------------------------------------------- sub parser { shift->_tool({ name => 'parser', @@ -231,17 +152,6 @@ sub parser_type { $_[0]->{'parser_type'}; } sub parser_args { shift->_args("parser", @_); } -# ---------------------------------------------------------------------- -# e.g. -# $sqlt->filters => [ -# sub { }, -# [ "NormalizeNames", field => "lc", tabel => "ucfirst" ], -# [ -# "DataTypeMap", -# "TEXT" => "BIGTEXT", -# ], -# ], -# ---------------------------------------------------------------------- sub filters { my $self = shift; my $filters = $self->{filters} ||= []; @@ -264,7 +174,6 @@ sub filters { return @$filters; } -# ---------------------------------------------------------------------- sub show_warnings { my $self = shift; my $arg = shift; @@ -275,7 +184,6 @@ sub show_warnings { } -# filename - get or set the filename sub filename { my $self = shift; if (@_) { @@ -299,13 +207,6 @@ sub filename { $self->{'filename'}; } -# ---------------------------------------------------------------------- -# 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 { my $self = shift; @@ -321,6 +222,7 @@ sub data { $data = join '', @$data; } elsif (isa($data, 'GLOB')) { + seek ($data, 0, 0) if eof ($data); local $/; $data = <$data>; } @@ -358,7 +260,6 @@ sub data { return $self->{'data'}; } -# ---------------------------------------------------------------------- sub reset { # # Deletes the existing Schema object so that future calls to translate @@ -369,7 +270,6 @@ sub reset { return 1; } -# ---------------------------------------------------------------------- sub schema { # # Returns the SQL::Translator::Schema object @@ -385,7 +285,6 @@ sub schema { return $self->{'schema'}; } -# ---------------------------------------------------------------------- sub trace { my $self = shift; my $arg = shift; @@ -395,21 +294,6 @@ sub trace { return $self->{'trace'} || 0; } -# ---------------------------------------------------------------------- -# 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); @@ -536,8 +420,13 @@ sub translate { # Run producer # Calling wantarray in the eval no work, wrong scope. my $wantarray = wantarray ? 1 : 0; - eval { $wantarray ? @producer_output = $producer->($self) : - $producer_output = $producer->($self) }; + 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"; @@ -547,36 +436,10 @@ sub translate { 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"); } @@ -618,8 +481,8 @@ sub _args { # ---------------------------------------------------------------------- # 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", # }, @_); @@ -632,7 +495,7 @@ sub _tool { 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; @@ -686,7 +549,7 @@ sub _list { 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 (); @@ -700,13 +563,13 @@ sub _list { } # - # 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$//; @@ -763,7 +626,7 @@ sub load { 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/; @@ -791,22 +654,18 @@ sub _load_sub { 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', @_); } @@ -832,28 +691,16 @@ sub _format_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 ) { @@ -1006,7 +853,7 @@ advantage is gained by passing options to the constructor. =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_table_names @@ -1030,9 +877,9 @@ The C method is an accessor/mutator, used to retrieve or define what subroutine is called to produce the output. A subroutine defined as a producer will be invoked as a function (I) and passed its container C instance, which it should -call the C method on, to get the C +call the C method on, to get the C generated by the parser. It is expected that the function transform the -schema structure to a string. The C instance is also useful +schema structure to a string. The C instance is also useful for informational purposes; for example, the type of the parser can be retrieved using the C method, and the C and C methods can be called when needed. @@ -1265,39 +1112,8 @@ Returns the version of the SQL::Translator release. =head1 AUTHORS -The following people have contributed to the SQLFairy project: - -=over 4 - -=item * Mark Addison - -=item * Sam Angiuoli - -=item * Dave Cash - -=item * Darren Chamberlain - -=item * Ken Y. Clark - -=item * Allen Day - -=item * Paul Harrington - -=item * Mikey Melillo - -=item * Chris Mungall - -=item * Ross Smith II - -=item * Gudmundur A. Thorisson - -=item * Chris To - -=item * Jason Williams - -=item * Ying Zhang - -=back +See the included AUTHORS file: +L If you would like to contribute to the project, you can send patches to the developers mailing list: @@ -1330,7 +1146,7 @@ Please use L for reporting bugs. =head1 PRAISE -If you find this module useful, please use +If you find this module useful, please use L to rate it. =head1 SEE ALSO