X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator.pm;h=04d4596c3cef2c65d1ab7c31be63402c9e21ff0a;hb=7d5bcab8b6c8f5edb64633f092245d97510a1a06;hp=c6ae9e246da687c88da0e7e7b10755e9b7bbd4e7;hpb=ca251f03f610bb7ffecd43806d043df4d88923c0;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index c6ae9e2..04d4596 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,7 +1,7 @@ package SQL::Translator; # ---------------------------------------------------------------------- -# $Id: Translator.pm,v 1.17 2003-02-26 13:08:59 dlc Exp $ +# $Id: Translator.pm,v 1.22 2003-04-17 23:16:28 allenday Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark , # darren chamberlain , @@ -27,7 +27,7 @@ use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR ); use base 'Class::Base'; $VERSION = '0.01'; -$REVISION = sprintf "%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/; +$REVISION = sprintf "%d.%02d", q$Revision: 1.22 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; $ERROR = ""; @@ -70,6 +70,14 @@ sub init { $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 + # + $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'}); + # # Set the parser_args and producer_args # @@ -238,8 +246,6 @@ sub producer_args { return $self->_args("producer", @_); } - - # ---------------------------------------------------------------------- # parser([$parser_spec]) # ---------------------------------------------------------------------- @@ -485,7 +491,7 @@ sub translate { $self->filename($filename); } - if (my $data = ($self->{'data'} || $self->{'datasource'})) { + if (my $data = ($args->{'data'} || $args->{'datasource'})) { $self->data($data); } @@ -493,7 +499,7 @@ sub translate { # Get the data. # ---------------------------------------------------------------- my $data = $self->data; - unless (length $$data) { + unless (ref($data) eq 'SCALAR' and length $$data) { return $self->error("Empty data file!"); } @@ -560,7 +566,7 @@ sub translate { # # ---------------------------------------------------------------------- sub list_parsers { - return _list("parsers"); + return shift->_list("parser"); } # ---------------------------------------------------------------------- @@ -570,7 +576,7 @@ sub list_parsers { # list_producers as well. # ---------------------------------------------------------------------- sub list_producers { - return _list("producers"); + return shift->_list("producer"); } @@ -613,14 +619,26 @@ sub _args { # _list($type) # ---------------------------------------------------------------------- sub _list { - my $type = ucfirst lc $_[0] || return (); - - load("SQL::Translator::$type"); - my $path = catfile(dirname($INC{'SQL/Translator/$type.pm'}), $type); - my $dh = IO::Dir->new($path); + my $self = shift; + my $type = shift || return (); + my $uctype = ucfirst lc $type; + my %found; + + load("SQL::Translator::$uctype") or return (); + my $path = catfile "SQL", "Translator", $uctype; + for (@INC) { + my $dir = catfile $_, $path; + $self->debug("_list_${type}s searching $dir"); + next unless -d $dir; + + my $dh = IO::Dir->new($dir); + for (grep /\.pm$/, $dh->read) { + s/\.pm$//; + $found{ join "::", "SQL::Translator::$uctype", $_ } = 1; + } + } - return map { join "::", "SQL::Translator::$type", $_ } - grep /\.pm$/, $dh->read; + return keys %found; } # ---------------------------------------------------------------------- @@ -631,13 +649,45 @@ sub _list { sub load { my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" }; return 1 if $INC{$module}; - + eval { require $module }; - - return if ($@); + + return __PACKAGE__->error($@) if ($@); return 1; } +sub format_table_name { + my $self = shift; + my $sub = shift; + $self->{_format_table_name} = $sub if ref($sub) eq 'CODE'; + return $self->{_format_table_name}->($sub,@_) if defined($self->{_format_table_name}); + return($sub); +} + +sub format_package_name { + my $self = shift; + my $sub = shift; + $self->{_format_package_name} = $sub if ref($sub) eq 'CODE'; + return $self->{_format_package_name}->($sub,@_) if defined($self->{_format_package_name}); + return($sub); +} + +sub format_fk_name { + my $self = shift; + my $sub = shift; + $self->{_format_fk_name} = $sub if ref($sub) eq 'CODE'; + return $self->{_format_fk_name}->($sub,@_) if defined($self->{_format_fk_name}); + return($sub); +} + +sub format_pk_name { + my $self = shift; + my $sub = shift; + $self->{_format_pk_name} = $sub if ref($sub) eq 'CODE'; + return $self->{_format_pk_name}->($sub,@_) if defined($self->{_format_pk_name}); + return($sub); +} + # ---------------------------------------------------------------------- # isa($ref, $type) # @@ -666,12 +716,18 @@ SQL::Translator - convert schema from one database to another use SQL::Translator; my $translator = SQL::Translator->new( - xlate => $xlate || {}, # Overrides for field translation - debug => $debug, # Print debug info - trace => $trace, # Print Parse::RecDescent trace - no_comments => $no_comments, # Don't include comments in output - show_warnings => $show_warnings, # Print name mutations, conflicts - add_drop_table => $add_drop_table, # Add "drop table" statements + debug => 1, # Print debug info + trace => 0, # Print Parse::RecDescent trace + no_comments => 0, # Don't include comments in output + show_warnings => 0, # Print name mutations, conflicts + add_drop_table => 1, # Add "drop table" statements + + #make all table names CAPS in producers which support this option + format_table_name => sub {my $tablename = shift; return uc($tablename)}, + #null-op formatting, only here for documentation's sake + format_package_name => sub {return shift}, + format_fk_name => sub {return shift}, + format_pk_name => sub {return shift}, ); my $output = $translator->translate( @@ -953,6 +1009,10 @@ along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +=head1 BUGS + +Please use http://rt.cpan.org/ for reporting bugs. + =head1 SEE ALSO L,