X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator.pm;h=4169faf31ffbd26fc9d8b9827af8e2039d3289af;hb=0c04c5a2210135419771878dc7e341a1cba52cca;hp=7b0dc5882e6014d6267864eb689de0ef0c81a99b;hpb=b03926cdac036bdbcf69e478ca29e1121c814646;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 7b0dc58..4169faf 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,37 +1,19 @@ package SQL::Translator; -# ---------------------------------------------------------------------- -# Copyright (C) 2002-2009 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 $DEFAULT_SUB $DEBUG $ERROR ); +use warnings; +our ( $DEFAULT_SUB, $DEBUG, $ERROR ); use base 'Class::Base'; -require 5.004; +require 5.005; -$VERSION = '0.09003'; +our $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); @@ -39,26 +21,8 @@ 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 ) = @_; # @@ -123,18 +87,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) ) { @@ -143,9 +104,6 @@ sub add_drop_table { return $self->{'add_drop_table'} || 0; } -# ---------------------------------------------------------------------- -# no_comments([$bool]) -# ---------------------------------------------------------------------- sub no_comments { my $self = shift; my $arg = shift; @@ -155,10 +113,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) ) { @@ -167,9 +121,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) ) { @@ -178,11 +129,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', @@ -191,32 +137,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', @@ -229,17 +153,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} ||= []; @@ -262,7 +175,6 @@ sub filters { return @$filters; } -# ---------------------------------------------------------------------- sub show_warnings { my $self = shift; my $arg = shift; @@ -273,7 +185,6 @@ sub show_warnings { } -# filename - get or set the filename sub filename { my $self = shift; if (@_) { @@ -297,13 +208,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; @@ -319,6 +223,7 @@ sub data { $data = join '', @$data; } elsif (isa($data, 'GLOB')) { + seek ($data, 0, 0) if eof ($data); local $/; $data = <$data>; } @@ -356,7 +261,6 @@ sub data { return $self->{'data'}; } -# ---------------------------------------------------------------------- sub reset { # # Deletes the existing Schema object so that future calls to translate @@ -367,7 +271,6 @@ sub reset { return 1; } -# ---------------------------------------------------------------------- sub schema { # # Returns the SQL::Translator::Schema object @@ -383,7 +286,6 @@ sub schema { return $self->{'schema'}; } -# ---------------------------------------------------------------------- sub trace { my $self = shift; my $arg = shift; @@ -393,21 +295,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); @@ -550,36 +437,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"); } @@ -621,8 +482,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", # }, @_); @@ -635,7 +496,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; @@ -689,7 +550,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 (); @@ -703,13 +564,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$//; @@ -766,7 +627,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/; @@ -794,22 +655,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', @_); } @@ -835,28 +692,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 ) { @@ -1009,7 +854,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 @@ -1033,9 +878,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. @@ -1268,47 +1113,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 * Anders Nor Berle - -=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 - -=item * Daniel Ruoso - -=item * Ryan D Johnson - -=item * Jonathan Yu - -=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: @@ -1341,7 +1147,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