package SQL::Translator;
# ----------------------------------------------------------------------
-# $Id: Translator.pm,v 1.68 2005-06-09 02:02:00 grommit Exp $
+# $Id: Translator.pm,v 1.69 2006-06-07 16:02:54 schiffbruechige Exp $
# ----------------------------------------------------------------------
# Copyright (C) 2002-4 The SQLFairy Authors
#
require 5.004;
-$VERSION = '0.07';
-$REVISION = sprintf "%d.%02d", q$Revision: 1.68 $ =~ /(\d+)\.(\d+)/;
+$VERSION = '0.08_01';
+$REVISION = sprintf "%d.%02d", q$Revision: 1.69 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
$ERROR = "";
$self->trace( $config->{'trace'} );
$self->validate( $config->{'validate'} );
+
+ $self->quote_table_names( (defined $config->{'quote_table_names'}
+ ? $config->{'quote_table_names'} : 1) );
+ $self->quote_field_names( (defined $config->{'quote_field_names'}
+ ? $config->{'quote_field_names'} : 1) );
return $self;
}
# ----------------------------------------------------------------------
+# quote_table_names([$bool])
+# ----------------------------------------------------------------------
+sub quote_table_names {
+ my $self = shift;
+ if ( defined (my $arg = shift) ) {
+ $self->{'quote_table_names'} = $arg ? 1 : 0;
+ }
+ return $self->{'quote_table_names'} || 0;
+}
+
+# ----------------------------------------------------------------------
+# quote_field_names([$bool])
+# ----------------------------------------------------------------------
+sub quote_field_names {
+ my $self = shift;
+ if ( defined (my $arg = shift) ) {
+ $self->{'quote_field_names'} = $arg ? 1 : 0;
+ }
+ return $self->{'quote_field_names'} || 0;
+}
+
+# ----------------------------------------------------------------------
# producer([$producer_spec])
#
# Get or set the producer for the current translator.
sub translate {
my $self = shift;
my ($args, $parser, $parser_type, $producer, $producer_type);
- my ($parser_output, $producer_output);
+ my ($parser_output, $producer_output, @producer_output);
# Parse arguments
if (@_ == 1) {
}
# Run producer
- eval { $producer_output = $producer->($self) };
- if ($@ || ! $producer_output) {
+ # Calling wantarray in the eval no work, wrong scope.
+ my $wantarray = wantarray ? 1 : 0;
+ eval { $wantarray ? @producer_output = $producer->($self) :
+ $producer_output = $producer->($self) };
+ if ($@ || !( $producer_output || @producer_output)) {
my $err = $@ || $self->error || "no results";
my $msg = "translate: Error with producer '$producer_type': $err";
return $self->error($msg);
}
- return $producer_output;
+ return wantarray ? @producer_output : $producer_output;
}
# ----------------------------------------------------------------------
show_warnings => 0,
# Add "drop table" statements
add_drop_table => 1,
+ # to quote or not to quote, thats the question
+ quote_table_names => 1,
+ quote_field_names => 1,
# Validate schema object
validate => 1,
# Make all table names CAPS in producers which support this option
=item *
+quote_table_names
+
+=item *
+
+quote_field_names
+
+=item *
+
no_comments
=item *
Toggles whether or not to add "DROP TABLE" statements just before the
create definitions.
+=head2 quote_table_names
+
+Toggles whether or not to quote table names with " in DROP and CREATE
+statements. The default (true) is to quote them.
+
+=head2 quote_field_names
+
+Toggles whether or not to quote field names with " in most
+statements. The default (true), is to quote them.
+
=head2 no_comments
Toggles whether to print comments in the output. Accepts a true or false
package SQL::Translator::Producer::DB2;
# -------------------------------------------------------------------
-# $Id: DB2.pm,v 1.2 2006-05-24 22:06:56 schiffbruechige Exp $
+# $Id: DB2.pm,v 1.3 2006-06-07 16:02:54 schiffbruechige Exp $
# -------------------------------------------------------------------
# Copyright (C) 2002-4 SQLFairy Authors
#
use warnings;
use strict;
use vars qw[ $VERSION $DEBUG $WARN ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
# of SQL data types, with field->extra entries being used to convert back to
# weird types like "polygon" if needed (IMO anyway)
-my %dt_translate = (
+my %dt_translate = ( );
+BEGIN {
+ %dt_translate = (
#
# MySQL types
#
varchar2 => 'varchar',
long => 'clob',
);
+}
my %db2_reserved = map { $_ => 1} qw/
ADD DETERMINISTIC LEAVE RESTART
my (@table_defs, @index_defs);
foreach my $table ($schema->get_tables)
{
- push @table_defs, 'DROP TABLE ' . $table->name . ";\n" if $add_drop_table;
+ push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
push @table_defs, create_table($table, {
no_comments => $no_comments});
push @trigger_defs, create_trigger($trigger);
}
- $output .= join("\n\n", @table_defs, @index_defs, @view_defs, @trigger_defs) . "\n";
+ return wantarray ? (@table_defs, @index_defs, @view_defs, @trigger_defs) :
+ $output . join("\n\n", @table_defs, @index_defs, @view_defs, @trigger_defs) . "\n";
}
{ my %objnames;
warn "$newname is a reserved word in DB2!" if $WARN;
}
- return sprintf("%-*s", $length-5, $newname);
+# return sprintf("%-*s", $length-5, $newname);
+ return $newname;
}
}
'DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
(" DEFAULT '" . $field->default_value . "'") : '';
+ return $field_def;
}
sub create_index
$trigger->database_event =~ /update_on/i ?
('UPDATE OF '. join(', ', $trigger->fields)) :
$trigger->database_event || 'UPDATE',
- $trigger->on_table->name,
+ $trigger->table->name,
$trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
$trigger->extra->{granularity} || 'FOR EACH ROW',
$trigger->action );
sub alter_field
{
my ($from_field, $to_field) = @_;
+
+ my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);
+
+ my $size = $to_field->size();
+ $data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';
+
+ # DB2 will only allow changing of varchar/vargraphic datatypes
+ # to extend their lengths. Or changing of text types to other
+ # texttypes, and numeric types to larger numeric types. (v8)
+ # We can also drop/add keys, checks and constraints, but not
+ # columns !?
+
+ my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
+ $to_field->table->name,
+ $to_field->name,
+ $data_type);
+
}
sub add_field
{
- my ($field) = @_;
+ my ($new_field) = @_;
+
+ my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
+ $new_field->table->name,
+ create_field($new_field));
+
+ return $out;
}
sub drop_field
{
my ($field) = @_;
+
+ return '';
}
1;
is($sql, << "SQL");
DROP TABLE Basic;
-
-CREATE TABLE Basic (
-id INTEGER GENERATED BY DEFAULT AS IDENTITY NOT NULL,
-title VARCHAR(100) NOT NULL DEFAULT 'hello',
-description VARCHAR(0) DEFAULT '',
-email VARCHAR(255),
-explicitnulldef VARCHAR(0),
-explicitemptystring VARCHAR(0) DEFAULT '',
-emptytagdef VARCHAR(0) DEFAULT '',
+CREATE TABLE Basic (
+id INTEGER GENERATED BY DEFAULT AS IDENTITY NOT NULL,
+title VARCHAR(100) NOT NULL DEFAULT 'hello',
+description VARCHAR(0) DEFAULT '',
+email VARCHAR(255),
+explicitnulldef VARCHAR(0),
+explicitemptystring VARCHAR(0) DEFAULT '',
+emptytagdef VARCHAR(0) DEFAULT '',
CONSTRAINT emailuniqueindex UNIQUE (email) ,
PRIMARY KEY(id)
);
--- /dev/null
+#!/usr/bin/perl
+use strict;
+
+use FindBin qw/$Bin/;
+use Test::More;
+use Test::SQL::Translator;
+use Test::Exception;
+use Data::Dumper;
+use SQL::Translator;
+use SQL::Translator::Schema::Constants;
+
+
+BEGIN {
+ maybe_plan(1, 'SQL::Translator::Parser::XML::SQLFairy',
+ 'SQL::Translator::Producer::DB2');
+}
+
+my $xmlfile = "$Bin/data/xml/schema.xml";
+
+my $sqlt;
+$sqlt = SQL::Translator->new(
+ no_comments => 1,
+ show_warnings => 1,
+ add_drop_table => 1,
+);
+
+die "Can't find test schema $xmlfile" unless -e $xmlfile;
+
+my @sql = $sqlt->translate(
+ from => 'XML-SQLFairy',
+ to => 'DB2',
+ filename => $xmlfile,
+) or die $sqlt->error;
+
+my $want = [ 'DROP TABLE Basic;',
+q|CREATE TABLE Basic (
+id INTEGER GENERATED BY DEFAULT AS IDENTITY NOT NULL,
+title VARCHAR(100) NOT NULL DEFAULT 'hello',
+description VARCHAR(0) DEFAULT '',
+email VARCHAR(255),
+explicitnulldef VARCHAR(0),
+explicitemptystring VARCHAR(0) DEFAULT '',
+emptytagdef VARCHAR(0) DEFAULT '',
+CONSTRAINT emailuniqueindex UNIQUE (email) ,
+ PRIMARY KEY(id)
+);|,
+
+'CREATE INDEX titleindex ON Basic ( title );',
+
+'CREATE VIEW email_list AS
+SELECT email FROM Basic WHERE email IS NOT NULL;',
+
+'CREATE TRIGGER foo_trigger after insert ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified=timestamp();'
+];
+
+is_deeply(\@sql, $want, 'Got correct DB2 statements in list context');
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use Test::SQL::Translator qw(maybe_plan);
+
+use Data::Dumper;
+use FindBin qw/$Bin/;
+
+# Testing 1,2,3,4...
+#=============================================================================
+
+BEGIN {
+ maybe_plan(4,
+ 'SQL::Translator::Producer::DB2',
+ 'Test::Differences',
+ )
+}
+use Test::Differences;
+use SQL::Translator;
+
+
+
+my $table = SQL::Translator::Schema::Table->new( name => 'mytable');
+
+my $field1 = SQL::Translator::Schema::Field->new( name => 'myfield',
+ table => $table,
+ data_type => 'VARCHAR',
+ size => 10,
+ default_value => undef,
+ is_auto_increment => 0,
+ is_nullable => 1,
+ is_foreign_key => 0,
+ is_unique => 0 );
+
+my $field1_sql = SQL::Translator::Producer::DB2::create_field($field1);
+
+is($field1_sql, 'myfield VARCHAR(10)', 'Create field works');
+
+my $field2 = SQL::Translator::Schema::Field->new( name => 'myfield',
+ table => $table,
+ data_type => 'VARCHAR',
+ size => 25,
+ default_value => undef,
+ is_auto_increment => 0,
+ is_nullable => 0,
+ is_foreign_key => 0,
+ is_unique => 0 );
+
+my $alter_field = SQL::Translator::Producer::DB2::alter_field($field1,
+ $field2);
+is($alter_field, 'ALTER TABLE mytable ALTER myfield SET DATATYPE VARCHAR(25)', 'Alter field works');
+
+my $add_field = SQL::Translator::Producer::DB2::add_field($field1);
+
+is($add_field, 'ALTER TABLE mytable ADD COLUMN myfield VARCHAR(10)', 'Add field works');
+
+my $drop_field = SQL::Translator::Producer::DB2::drop_field($field2);
+is($drop_field, '', 'Drop field works');
projects / dbsrgits/SQL-Translator.git / commitdiff