Updated tests.
Added 'pretty' option to HTML producer.
Compacted format_*_name methods.
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
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,
#!/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 <kycl4rk@users.sourceforge.net>,
# darren chamberlain <darren@cpan.org>
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
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.
'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
producer_args => {
imap_file => $imap_file,
imap_url => $imap_url,
+ pretty => $pretty,
},
);
$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;
}
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 <kclark@cpan.org>,
# darren chamberlain <darren@cpan.org>,
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 = "";
# ----------------------------------------------------------------------
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};
}
# ----------------------------------------------------------------------
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 <allenday@ucla.edu>,
# Ying Zhang <zyolive@yahoo.com>
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;
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 {
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 <kclark@cpan.org>
#
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);
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(
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 <kclark@cpan.org>
#
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 {
=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'} } );
}
# ----------------------------------------------------------------------
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' );
# 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;
<sqlt:is_nullable>1</sqlt:is_nullable>
<sqlt:is_foreign_key>0</sqlt:is_foreign_key>
<sqlt:order>3</sqlt:order>
- <sqlt:size>0</sqlt:size>
+ <sqlt:size>65000</sqlt:size>
</sqlt:field>
<sqlt:field>
<sqlt:name>email</sqlt:name>
<sqlt:is_nullable>1</sqlt:is_nullable>
<sqlt:is_foreign_key>0</sqlt:is_foreign_key>
<sqlt:order>7</sqlt:order>
- <sqlt:size>0</sqlt:size>
+ <sqlt:size>65000</sqlt:size>
</sqlt:field>
<sqlt:field>
<sqlt:name>email</sqlt:name>
projects / dbsrgits/SQL-Translator.git / commitdiff