From: Jess Robinson Date: Wed, 7 Jun 2006 16:02:54 +0000 (+0000) Subject: Producers can now return individual statements as s list, if wantarray set X-Git-Tag: v0.11008~433 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5e2c196a218b2b51bdcece29f1c96fe18184a88a;p=dbsrgits%2FSQL-Translator.git Producers can now return individual statements as s list, if wantarray set DB2 implements this, produces each individual statement on demand as well Also implements alter_field, add_field etc for use by Diff Added quote-field-names, quote-table-names params --- diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index e6dbc5b..ec2c39b 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,7 +1,7 @@ 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 # @@ -26,8 +26,8 @@ use base 'Class::Base'; 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 = ""; @@ -125,6 +125,11 @@ sub init { $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; } @@ -154,6 +159,28 @@ sub no_comments { # ---------------------------------------------------------------------- +# 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. @@ -386,7 +413,7 @@ sub trace { 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) { @@ -507,14 +534,17 @@ sub translate { } # 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; } # ---------------------------------------------------------------------- @@ -862,6 +892,9 @@ SQL::Translator - manipulate structured data definitions (SQL and more) 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 @@ -945,6 +978,14 @@ add_drop_table =item * +quote_table_names + +=item * + +quote_field_names + +=item * + no_comments =item * @@ -968,6 +1009,16 @@ advantage is gained by passing options to the constructor. 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 diff --git a/lib/SQL/Translator/Producer/DB2.pm b/lib/SQL/Translator/Producer/DB2.pm index e59704e..3f49293 100644 --- a/lib/SQL/Translator/Producer/DB2.pm +++ b/lib/SQL/Translator/Producer/DB2.pm @@ -1,7 +1,7 @@ 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 # @@ -39,7 +39,7 @@ Creates an SQL DDL suitable for DB2. 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; @@ -52,7 +52,9 @@ use SQL::Translator::Utils qw(header_comment); # 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 # @@ -106,6 +108,7 @@ my %dt_translate = ( varchar2 => 'varchar', long => 'clob', ); +} my %db2_reserved = map { $_ => 1} qw/ ADD DETERMINISTIC LEAVE RESTART @@ -205,7 +208,7 @@ sub produce 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}); @@ -226,7 +229,8 @@ sub produce 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; @@ -253,7 +257,8 @@ sub produce warn "$newname is a reserved word in DB2!" if $WARN; } - return sprintf("%-*s", $length-5, $newname); +# return sprintf("%-*s", $length-5, $newname); + return $newname; } } @@ -311,6 +316,7 @@ sub create_field 'DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ? (" DEFAULT '" . $field->default_value . "'") : ''; + return $field_def; } sub create_index @@ -378,7 +384,7 @@ sub create_trigger $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 ); @@ -390,15 +396,40 @@ sub create_trigger 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; diff --git a/t/43xml-to-db2.t b/t/43xml-to-db2.t index c4bff92..f48c609 100644 --- a/t/43xml-to-db2.t +++ b/t/43xml-to-db2.t @@ -35,15 +35,14 @@ my $sql = $sqlt->translate( 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) ); diff --git a/t/44-xml-to-db2-array.t b/t/44-xml-to-db2-array.t new file mode 100644 index 0000000..d20ba89 --- /dev/null +++ b/t/44-xml-to-db2-array.t @@ -0,0 +1,56 @@ +#!/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 diff --git a/t/45db2-producer.t b/t/45db2-producer.t new file mode 100644 index 0000000..411b6e9 --- /dev/null +++ b/t/45db2-producer.t @@ -0,0 +1,62 @@ +#!/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');