From: Darren Chamberlain Date: Wed, 20 Aug 2003 13:50:47 +0000 (+0000) Subject: Updated MANIFEST. X-Git-Tag: v0.04~288 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1ea530d4f2822ce6f7c59e436664757c550f5f66;p=dbsrgits%2FSQL-Translator.git Updated MANIFEST. Updated tests. Added 'pretty' option to HTML producer. Compacted format_*_name methods. --- diff --git a/MANIFEST b/MANIFEST index a4d7867..6dd4cae 100644 --- a/MANIFEST +++ b/MANIFEST @@ -67,3 +67,10 @@ t/data/mysql/sqlfxml-producer-basic.sql t/data/pgsql/Chado-CV-PostGreSQL.sql t/data/template/basic.tt t/data/xml/schema-basic.xml +t/19sybase-parser.t +t/20format_X_name.t +t/data/mysql/entire_syntax.sql +t/data/pgsql/entire_syntax.sql +t/data/sybase/create.sql +t/data/xml/schema-basic-attribs.xml +t/data/xml/schema-basic-no_ns.xml diff --git a/Makefile.PL b/Makefile.PL index f90d648..14b4c78 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -37,14 +37,14 @@ print "\n"; if (@{$missing{'optional'}} + @{$missing{'required'}}) { print "Some components might not work correctly:\n"; my $count; - if ($missing{'required'}) { + if (@{$missing{'required'}}) { $count = scalar(@{$missing{'required'}}); printf " You are missing %d required module%s: %s\n", $count, $count == 1 ? '' : 's', join ', ', @{$missing{'required'}}; } - if ($missing{'optional'}) { + if (@{$missing{'optional'}}) { $count = scalar(@{$missing{'optional'}}); printf " You are missing %d optional module%s: %s\n", $count, diff --git a/bin/sql_translator.pl b/bin/sql_translator.pl index 358ee08..fe0cf6a 100755 --- a/bin/sql_translator.pl +++ b/bin/sql_translator.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl -w # ------------------------------------------------------------------- -# $Id: sql_translator.pl,v 1.11 2003-07-18 22:56:41 kycl4rk Exp $ +# $Id: sql_translator.pl,v 1.12 2003-08-20 13:50:46 dlc Exp $ # ------------------------------------------------------------------- # Copyright (C) 2002 Ken Y. Clark , # darren chamberlain @@ -29,7 +29,7 @@ use SQL::Translator; use Data::Dumper; use vars qw( $VERSION ); -$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/; my $from; # the original database my $to; # the destination database @@ -48,6 +48,7 @@ my $record_separator; # for xSV files my $validate; # whether to validate the parsed document my $imap_file; # filename where to place image map coords my $imap_url; # URL to use in making image map +my $pretty; # use CGI::Pretty instead of CGI (HTML producer) # # Get options, explain how to use the script if necessary. @@ -69,6 +70,7 @@ GetOptions( 'rs:s' => \$record_separator, 'imap-file:s' => \$imap_file, 'imap-url:s' => \$imap_url, + 'pretty!' => \$pretty, ) or pod2usage(2); my @files = @ARGV; # the create script(s) for the original db @@ -94,6 +96,7 @@ my $translator = SQL::Translator->new( producer_args => { imap_file => $imap_file, imap_url => $imap_url, + pretty => $pretty, }, ); @@ -119,7 +122,7 @@ $translator->parser($from); $translator->producer($to); for my $file (@files) { - my $output = $translator->translate( $file ) or die + my $output = $translator->translate(file => $file) or die "Error: " . $translator->error; print $output; } diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 873a38a..319cea7 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,7 +1,7 @@ package SQL::Translator; # ---------------------------------------------------------------------- -# $Id: Translator.pm,v 1.39 2003-08-18 16:53:16 dlc Exp $ +# $Id: Translator.pm,v 1.40 2003-08-20 13:50:46 dlc Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark , # darren chamberlain , @@ -29,7 +29,7 @@ use base 'Class::Base'; require 5.004; $VERSION = '0.02'; -$REVISION = sprintf "%d.%02d", q$Revision: 1.39 $ =~ /(\d+)\.(\d+)/; +$REVISION = sprintf "%d.%02d", q$Revision: 1.40 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; $ERROR = ""; @@ -692,62 +692,43 @@ sub load { # ---------------------------------------------------------------------- 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; + return shift->_format_name('_format_table_name', @_); } # ---------------------------------------------------------------------- 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; + return shift->_format_name('_format_package_name', @_); } # ---------------------------------------------------------------------- sub format_fk_name { - my $self = shift; - - if ( ref $_[0] eq 'CODE' ) { - $self->{'_format_fk_name'} = shift; - } - - if ( @_ ) { - if ( defined $self->{'_format_fk_name'} ) { - return $self->{'_format_fk_name'}->( @_ ); - } - else { - return ''; - } - } - - return $self->{'_format_fk_name'}; + return shift->_format_name('_format_fk_name', @_); } # ---------------------------------------------------------------------- sub format_pk_name { + return shift->_format_name('_format_pk_name', @_); +} + +# ---------------------------------------------------------------------- +# The other format_*_name methods rely on this one. It optionally +# accepts a subroutine ref as the first argument (or uses an identity +# sub if one isn't provided or it doesn't already exist), and applies +# it to the rest of the arguments (if any). +# ---------------------------------------------------------------------- +sub _format_name { my $self = shift; + my $field = shift; + my @args = @_; - if ( ref $_[0] eq 'CODE' ) { - $self->{'_format_pk_name'} = shift; + if (ref($args[0]) eq 'CODE') { + $self->{$field} = shift @args; } - - if ( @_ ) { - if ( defined $self->{'_format_pk_name'} ) { - return $self->{'_format_pk_name'}->( @_ ); - } - else { - return ''; - } + elsif (! exists $self->{$field}) { + $self->{$field} = sub { return shift }; } - return $self->{'_format_pk_name'}; + return @args ? $self->{$field}->(@args) : $self->{$field}; } # ---------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Producer/ClassDBI.pm b/lib/SQL/Translator/Producer/ClassDBI.pm index 8ed6adb..6e1469c 100755 --- a/lib/SQL/Translator/Producer/ClassDBI.pm +++ b/lib/SQL/Translator/Producer/ClassDBI.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::ClassDBI; # ------------------------------------------------------------------- -# $Id: ClassDBI.pm,v 1.33 2003-08-18 20:35:06 dlc Exp $ +# $Id: ClassDBI.pm,v 1.34 2003-08-20 13:50:46 dlc Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Allen Day , # Ying Zhang @@ -23,7 +23,7 @@ package SQL::Translator::Producer::ClassDBI; use strict; use vars qw[ $VERSION $DEBUG ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/; $DEBUG = 1 unless defined $DEBUG; use SQL::Translator::Schema::Constants; @@ -246,7 +246,7 @@ sub produce { if(! $packages{ $ref_pkg }{ 'has_many' }{ $table_name } ){ # ADD CALLBACK FOR PLURALIZATION MANGLING HERE push @{ $packages{ $ref_pkg }{'has_many'}{ $table_name } }, - "sub $table_name\s {\n return shift->$table_name\_$field_name\n}\n\n"; + "sub ${table_name}s {\n return shift->$table_name\_$field_name\n}\n\n"; #else ugly } else { diff --git a/lib/SQL/Translator/Producer/HTML.pm b/lib/SQL/Translator/Producer/HTML.pm index d598dc2..0894a79 100644 --- a/lib/SQL/Translator/Producer/HTML.pm +++ b/lib/SQL/Translator/Producer/HTML.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::HTML; # ------------------------------------------------------------------- -# $Id: HTML.pm,v 1.6 2003-08-19 15:43:52 kycl4rk Exp $ +# $Id: HTML.pm,v 1.7 2003-08-20 13:50:47 dlc Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -24,7 +24,7 @@ use strict; use CGI; use Data::Dumper; use vars qw[ $VERSION ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(header_comment); @@ -35,7 +35,9 @@ sub produce { my $schema = $t->schema; my $schema_name = $schema->name || 'Schema'; my $args = $t->producer_args; - my $q = CGI->new; + my $q = defined $args->{'pretty'} + ? do { require CGI::Pretty; CGI::Pretty->new } + : CGI->new; my $title = $args->{'title'} || "Description of $schema_name"; my $html = $q->start_html( diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 2fbe1c6..904fb3c 100644 --- a/lib/SQL/Translator/Schema/Table.pm +++ b/lib/SQL/Translator/Schema/Table.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Table; # ---------------------------------------------------------------------- -# $Id: Table.pm,v 1.10 2003-06-27 16:47:40 kycl4rk Exp $ +# $Id: Table.pm,v 1.11 2003-08-20 13:50:47 dlc Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -50,7 +50,7 @@ use SQL::Translator::Schema::Index; use base 'Class::Base'; use vars qw( $VERSION $FIELD_ORDER ); -$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/; # ---------------------------------------------------------------------- sub init { @@ -264,15 +264,19 @@ all the comments joined on newlines. =cut my $self = shift; + $self->{'comments'} = [ ] + unless (defined $self->{'comments'} && + ref($self->{'comments'}) eq 'ARRAY'); for my $arg ( @_ ) { $arg = $arg->[0] if ref $arg; - push @{ $self->{'comments'} }, $arg; + push @{ $self->{'comments'} }, $arg + if defined $arg; } return wantarray - ? @{ $self->{'comments'} || [] } - : join( "\n", @{ $self->{'comments'} || [] } ); + ? @{ $self->{'comments'} } + : join( "\n", @{ $self->{'comments'} } ); } # ---------------------------------------------------------------------- diff --git a/t/02mysql-parser.t b/t/02mysql-parser.t index 5d0e3c9..7d3ba41 100644 --- a/t/02mysql-parser.t +++ b/t/02mysql-parser.t @@ -38,7 +38,7 @@ use SQL::Translator::Schema::Constants; is( $f2->name, 'a_session', 'Second field name is "a_session"' ); is( $f2->data_type, 'text', 'Type is "text"' ); - is( $f2->size, 0, 'Size is "0"' ); + is( $f2->size, 65000, 'Size is "65000"' ); is( $f2->is_nullable, 1, 'Field can be null' ); is( $f2->default_value, undef, 'Default value is undefined' ); is( $f2->is_primary_key, 0, 'Field is not PK' ); diff --git a/t/17sqlfxml-producer.t b/t/17sqlfxml-producer.t index 0ac36c5..b1b09a4 100644 --- a/t/17sqlfxml-producer.t +++ b/t/17sqlfxml-producer.t @@ -4,6 +4,8 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +local $^W = 0; + use strict; use Test::More; use Test::Exception; @@ -78,7 +80,7 @@ $ans = <1 0 3 - 0 + 65000 email @@ -185,7 +187,7 @@ $ans = <1 0 7 - 0 + 65000 email