From: Jess Robinson Date: Sun, 23 Jul 2006 14:03:52 +0000 (+0000) Subject: Splitting of MySQL, Postgres and SQLite producers into sub methods X-Git-Tag: v0.11008~417 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bfb5a56826726f1c0da047c5bd4864facfc00964;p=dbsrgits%2FSQL-Translator.git Splitting of MySQL, Postgres and SQLite producers into sub methods Added "alter_*" methods to MySQL and Postgres producers --- diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm index d3bec7e..39d58f6 100644 --- a/lib/SQL/Translator/Producer/MySQL.pm +++ b/lib/SQL/Translator/Producer/MySQL.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::MySQL; # ------------------------------------------------------------------- -# $Id: MySQL.pm,v 1.48 2006-07-16 13:57:49 schiffbruechige Exp $ +# $Id: MySQL.pm,v 1.49 2006-07-23 14:03:52 schiffbruechige Exp $ # ------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -93,7 +93,7 @@ Set the fields charater set and collation order. use strict; use warnings; use vars qw[ $VERSION $DEBUG ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.48 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.49 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -171,7 +171,7 @@ sub produce { # print "@table_defs\n"; - return wantarray ? ($create, @table_defs, 'SET foreign_key_checks=1') : $create . join ('', @table_defs, "SET foreign_key_checks=1;\n\n"); + return wantarray ? ($create, @table_defs, 'SET foreign_key_checks=1;') : $create . join ('', @table_defs, "SET foreign_key_checks=1;\n\n"); } sub create_table diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm index f97669c..e34d31f 100644 --- a/lib/SQL/Translator/Producer/PostgreSQL.pm +++ b/lib/SQL/Translator/Producer/PostgreSQL.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::PostgreSQL; # ------------------------------------------------------------------- -# $Id: PostgreSQL.pm,v 1.23 2005-07-05 16:20:43 mwz444 Exp $ +# $Id: PostgreSQL.pm,v 1.24 2006-07-23 14:03:52 schiffbruechige Exp $ # ------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -37,15 +37,21 @@ producer. =cut use strict; +use warnings; use vars qw[ $DEBUG $WARN $VERSION ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.23 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.24 $ =~ /(\d+)\.(\d+)/; $DEBUG = 1 unless defined $DEBUG; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(header_comment); use Data::Dumper; -my %translate = ( +my %translate; +my $max_id_length; + +BEGIN { + + %translate = ( # # MySQL types # @@ -100,6 +106,8 @@ my %translate = ( float => 'numeric', ); + $max_id_length = 62; +} my %reserved = map { $_, 1 } qw[ ALL ANALYSE ANALYZE AND ANY AS ASC BETWEEN BINARY BOTH @@ -118,7 +126,7 @@ my %reserved = map { $_, 1 } qw[ UNION UNIQUE USER USING VERBOSE WHEN WHERE ]; -my $max_id_length = 62; +# my $max_id_length = 62; my %used_identifiers = (); my %global_names; my %unreserve; @@ -174,262 +182,33 @@ sub produce { my $add_drop_table = $translator->add_drop_table; my $schema = $translator->schema; + my $qt = ''; + $qt = '"' if ($translator->quote_table_names); + my $qf = ''; + $qf = '"' if ($translator->quote_field_names); + my $output; $output .= header_comment unless ($no_comments); - my %used_index_names; +# my %used_index_names; - my @fks; + my @table_defs; for my $table ( $schema->get_tables ) { - my $table_name = $table->name or next; - $table_name = mk_name( $table_name, '', undef, 1 ); - my $table_name_ur = unreserve($table_name); - -print STDERR "$table_name table_name\n"; - my ( @comments, @field_defs, @sequence_defs, @constraint_defs ); - - push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments; - - if ( $table->comments and !$no_comments ){ - my $c = "-- Comments: \n-- "; - $c .= join "\n-- ", $table->comments; - $c .= "\n--"; - push @comments, $c; - } - - # - # Fields - # - my %field_name_scope; - for my $field ( $table->get_fields ) { - my $field_name = mk_name( - $field->name, '', \%field_name_scope, 1 - ); - my $field_name_ur = unreserve( $field_name, $table_name ); - my $field_comments = $field->comments - ? "-- " . $field->comments . "\n " - : ''; - - my $field_def = $field_comments.qq["$field_name_ur"]; - - # - # Datatype - # - my @size = $field->size; - my $data_type = lc $field->data_type; - my %extra = $field->extra; - my $list = $extra{'list'} || []; - # todo deal with embedded quotes - my $commalist = join( ', ', map { qq['$_'] } @$list ); - my $seq_name; - - if ( $data_type eq 'enum' ) { - my $len = 0; - $len = ($len < length($_)) ? length($_) : $len for (@$list); - my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' ); - push @constraint_defs, - qq[Constraint "$chk_name" CHECK ("$field_name" ]. - qq[IN ($commalist))]; - $data_type = 'character varying'; - } - elsif ( $data_type eq 'set' ) { - $data_type = 'character varying'; - } - elsif ( $field->is_auto_increment ) { - if ( defined $size[0] && $size[0] > 11 ) { - $data_type = 'bigserial'; - } - else { - $data_type = 'serial'; - } - undef @size; - } - else { - $data_type = defined $translate{ $data_type } ? - $translate{ $data_type } : - $data_type; - } - - if ( $data_type =~ /timestamp/i ) { - if ( defined $size[0] && $size[0] > 6 ) { - $size[0] = 6; - } - } - - if ( $data_type eq 'integer' ) { - if ( defined $size[0] ) { - if ( $size[0] > 10 ) { - $data_type = 'bigint'; - } - elsif ( $size[0] < 5 ) { - $data_type = 'smallint'; - } - else { - $data_type = 'integer'; - } - } - else { - $data_type = 'integer'; - } - } - - # - # PG doesn't need a size for integers or text - # - undef @size if $data_type =~ m/(integer|smallint|bigint|text)/; - - $field_def .= " $data_type"; - - if ( defined $size[0] && $size[0] > 0 ) { - $field_def .= '(' . join( ',', @size ) . ')'; - } - - # - # Default value -- disallow for timestamps - # - my $default = $data_type =~ /(timestamp|date)/i - ? undef : $field->default_value; - if ( defined $default ) { - $field_def .= sprintf( ' DEFAULT %s', - ( $field->is_auto_increment && $seq_name ) - ? qq[nextval('"$seq_name"'::text)] : - ( $default =~ m/null/i ) ? 'NULL' : "'$default'" - ); - } - - # - # Not null constraint - # - $field_def .= ' NOT NULL' unless $field->is_nullable; - - push @field_defs, $field_def; - } - - # - # Index Declarations - # - my @index_defs = (); - my $idx_name_default; - for my $index ( $table->get_indices ) { - my $name = $index->name || ''; - if ( $name ) { - $name = next_unused_name($name, \%used_index_names); - $used_index_names{$name} = $name; - } - - my $type = $index->type || NORMAL; - my @fields = - map { $_ =~ s/\(.+\)//; $_ } - map { unreserve( $_, $table_name ) } - $index->fields; - next unless @fields; - - my $def_start = qq[Constraint "$name" ]; - if ( $type eq PRIMARY_KEY ) { - push @constraint_defs, "${def_start}PRIMARY KEY ". - '("' . join( '", "', @fields ) . '")'; - } - elsif ( $type eq UNIQUE ) { - push @constraint_defs, "${def_start}UNIQUE " . - '("' . join( '", "', @fields ) . '")'; - } - elsif ( $type eq NORMAL ) { - push @index_defs, - 'CREATE INDEX "' . $name . "\" on $table_name_ur (". - join( ', ', map { qq["$_"] } @fields ). - ');' - ; - } - else { - warn "Unknown index type ($type) on table $table_name.\n" - if $WARN; - } - } - - # - # Table constraints - # - my $c_name_default; - for my $c ( $table->get_constraints ) { - my $name = $c->name || ''; - if ( $name ) { - $name = next_unused_name($name, \%used_index_names); - $used_index_names{$name} = $name; - } - - my @fields = - map { $_ =~ s/\(.+\)//; $_ } - map { unreserve( $_, $table_name ) } - $c->fields; - - my @rfields = - map { $_ =~ s/\(.+\)//; $_ } - map { unreserve( $_, $table_name ) } - $c->reference_fields; - - next if !@fields && $c->type ne CHECK_C; - - my $def_start = $name ? qq[Constraint "$name" ] : ''; - if ( $c->type eq PRIMARY_KEY ) { - push @constraint_defs, "${def_start}PRIMARY KEY ". - '("' . join( '", "', @fields ) . '")'; - } - elsif ( $c->type eq UNIQUE ) { - $name = next_unused_name($name, \%used_index_names); - $used_index_names{$name} = $name; - push @constraint_defs, "${def_start}UNIQUE " . - '("' . join( '", "', @fields ) . '")'; - } - elsif ( $c->type eq CHECK_C ) { - my $expression = $c->expression; - push @constraint_defs, "${def_start}CHECK ($expression)"; - } - elsif ( $c->type eq FOREIGN_KEY ) { - my $def .= "ALTER TABLE $table_name ADD FOREIGN KEY (" . - join( ', ', map { qq["$_"] } @fields ) . ')' . - "\n REFERENCES " . $c->reference_table; - - if ( @rfields ) { - $def .= ' ("' . join( '", "', @rfields ) . '")'; - } - - if ( $c->match_type ) { - $def .= ' MATCH ' . - ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL'; - } - - if ( $c->on_delete ) { - $def .= ' ON DELETE '.join( ' ', $c->on_delete ); - } - - if ( $c->on_update ) { - $def .= ' ON UPDATE '.join( ' ', $c->on_update ); - } - - push @fks, "$def;"; - } - } - - my $create_statement; - $create_statement = qq[DROP TABLE "$table_name_ur";\n] - if $add_drop_table; - $create_statement .= qq[CREATE TABLE "$table_name_ur" (\n]. - join( ",\n", map { " $_" } @field_defs, @constraint_defs ). - "\n);" - ; - - $output .= join( "\n\n", - @comments, - @sequence_defs, - $create_statement, - @index_defs, - '' - ); + + push @table_defs, create_table($table, { quote_table_names => $qt, + quote_field_names => $qf, + no_comments => $no_comments, + add_drop_table => $add_drop_table,}); + +# $output .= join( "\n\n", +# @comments, +# @sequence_defs, +# $create_statement, +# @index_defs, +# '' + # ); } - if ( @fks ) { - $output .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments; - $output .= join( "\n\n", @fks ); - } + $output = join("\n\n", @table_defs); if ( $WARN ) { if ( %truncated ) { @@ -454,6 +233,7 @@ sub mk_name { my $scope = shift || ''; my $critical = shift || ''; my $basename_orig = $basename; +# my $max_id_length = 62; my $max_name = $type ? $max_id_length - (length($type) + 1) : $max_id_length; @@ -493,7 +273,7 @@ sub unreserve { my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : ''; # also trap fields that don't begin with a letter - return $name if !$reserved{ uc $name } && $name =~ /^[a-z]/i; + return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i; if ( $schema_obj_name ) { ++$unreserve{"$schema_obj_name.$name"}; @@ -527,6 +307,403 @@ sub next_unused_name { return $name; } +sub create_table +{ + my ($table, $options) = @_; + + my $qt = $options->{quote_table_names} || ''; + my $qf = $options->{quote_field_names} || ''; + my $no_comments = $options->{no_comments} || 0; + my $add_drop_table = $options->{add_drop_table} || 0; + + my $table_name = $table->name or next; + $table_name = mk_name( $table_name, '', undef, 1 ); + my $table_name_ur = $qt ? unreserve($table_name) : $table_name; + $table->name($table_name_ur); + +# print STDERR "$table_name table_name\n"; + my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @fks ); + + push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments; + + if ( $table->comments and !$no_comments ){ + my $c = "-- Comments: \n-- "; + $c .= join "\n-- ", $table->comments; + $c .= "\n--"; + push @comments, $c; + } + + # + # Fields + # + my %field_name_scope; + for my $field ( $table->get_fields ) { + push @field_defs, create_field($field, { quote_table_names => $qt, + quote_field_names => $qf, + table_name => $table_name_ur, + constraint_defs => \@constraint_defs,}); + } + + # + # Index Declarations + # + my @index_defs = (); + # my $idx_name_default; + for my $index ( $table->get_indices ) { + my ($idef, $constraints) = create_index($index, + { + quote_field_names => $qf, + quote_table_names => $qt, + table_name => $table_name, + }); + push @index_defs, $idef; + push @constraint_defs, @$constraints; + } + + # + # Table constraints + # + my $c_name_default; + for my $c ( $table->get_constraints ) { + my ($cdefs, $fks) = create_constraint($c, + { + quote_field_names => $qf, + quote_table_names => $qt, + table_name => $table_name, + }); + push @constraint_defs, @$cdefs; + push @fks, @$fks; + } + + my $create_statement; + $create_statement = join("\n", @comments); + $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt;\n] + if $add_drop_table; + $create_statement .= qq[CREATE TABLE $qt$table_name_ur$qt (\n]. + join( ",\n", map { " $_" } @field_defs, @constraint_defs ). + "\n);" + ; + if ( @fks ) { + $create_statement .= "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments; + $create_statement .= join( "\n\n", @fks ); + } + + $create_statement .= "\n" . join(";\n", @index_defs) . "\n"; + + return $create_statement; +} + +{ + + my %field_name_scope; + + sub create_field + { + my ($field, $options) = @_; + + my $qt = $options->{quote_table_names} || ''; + my $qf = $options->{quote_field_names} || ''; + my $table_name = $field->table->name; + my $constraint_defs = $options->{constraint_defs} || []; + + $field_name_scope{$table_name} ||= {}; + my $field_name = mk_name( + $field->name, '', $field_name_scope{$table_name}, 1 + ); + my $field_name_ur = $qf ? unreserve($field_name, $table_name ) : $field_name; + $field->name($field_name_ur); + my $field_comments = $field->comments + ? "-- " . $field->comments . "\n " + : ''; + + my $field_def = $field_comments.qq[$qf$field_name_ur$qf]; + + # + # Datatype + # + my @size = $field->size; + my $data_type = lc $field->data_type; + my %extra = $field->extra; + my $list = $extra{'list'} || []; + # todo deal with embedded quotes + my $commalist = join( ', ', map { qq['$_'] } @$list ); + my $seq_name; + + $field_def .= ' '. convert_datatype($field); + + # + # Default value -- disallow for timestamps + # + my $default = $data_type =~ /(timestamp|date)/i + ? undef : $field->default_value; + if ( defined $default ) { + $field_def .= sprintf( ' DEFAULT %s', + ( $field->is_auto_increment && $seq_name ) + ? qq[nextval('"$seq_name"'::text)] : + ( $default =~ m/null/i ) ? 'NULL' : "'$default'" + ); + } + + # + # Not null constraint + # + $field_def .= ' NOT NULL' unless $field->is_nullable; + + return $field_def; + } +} + +{ + my %used_index_names; + + sub create_index + { + my ($index, $options) = @_; + + my $qt = $options->{quote_table_names} ||''; + my $qf = $options->{quote_field_names} ||''; + my $table_name = $index->table->name; + my $table_name_ur = $qt ? unreserve($table_name) : $table_name; + + my ($index_def, @constraint_defs); + + $used_index_names{$table_name} ||= {}; + my $name = $index->name || ''; + if ( $name ) { + $name = next_unused_name($name, $used_index_names{$table_name}); + $used_index_names{$name} = $name; + } + + my $type = $index->type || NORMAL; + my @fields = + map { $_ =~ s/\(.+\)//; $_ } + map { $qt ? unreserve($_, $table_name ) : $_ } + $index->fields; + next unless @fields; + + my $def_start = qq[Constraint "$name" ]; + if ( $type eq PRIMARY_KEY ) { + push @constraint_defs, "${def_start}PRIMARY KEY ". + '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')'; + } + elsif ( $type eq UNIQUE ) { + push @constraint_defs, "${def_start}UNIQUE " . + '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')'; + } + elsif ( $type eq NORMAL ) { + $index_def = + "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name_ur}${qt} (". + join( ', ', map { qq[$qf$_$qf] } @fields ). + ');' + ; + } + else { + warn "Unknown index type ($type) on table $table_name.\n" + if $WARN; + } + + return $index_def, \@constraint_defs; + } + + sub create_constraint + { + my ($c, $options) = @_; + + my $qf = $options->{quote_field_names} ||''; + my $qt = $options->{quote_table_names} ||''; + my $table_name = $c->table->name; + my (@constraint_defs, @fks); + + my $name = $c->name || ''; + if ( $name ) { + $name = next_unused_name($name, \%used_index_names); + $used_index_names{$name} = $name; + } + + my @fields = + map { $_ =~ s/\(.+\)//; $_ } + map { $qt ? unreserve( $_, $table_name ) : $_} + $c->fields; + + my @rfields = + map { $_ =~ s/\(.+\)//; $_ } + map { $qt ? unreserve( $_, $table_name ) : $_} + $c->reference_fields; + + next if !@fields && $c->type ne CHECK_C; + my $def_start = $name ? qq[Constraint "$name" ] : ''; + if ( $c->type eq PRIMARY_KEY ) { + push @constraint_defs, "${def_start}PRIMARY KEY ". + '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')'; + } + elsif ( $c->type eq UNIQUE ) { + $name = next_unused_name($name, \%used_index_names); + $used_index_names{$name} = $name; + push @constraint_defs, "${def_start}UNIQUE " . + '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')'; + } + elsif ( $c->type eq CHECK_C ) { + my $expression = $c->expression; + push @constraint_defs, "${def_start}CHECK ($expression)"; + } + elsif ( $c->type eq FOREIGN_KEY ) { + my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" . + join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' . + "\n REFERENCES " . $qt . $c->reference_table . $qt; + + if ( @rfields ) { + $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')'; + } + + if ( $c->match_type ) { + $def .= ' MATCH ' . + ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL'; + } + + if ( $c->on_delete ) { + $def .= ' ON DELETE '.join( ' ', $c->on_delete ); + } + + if ( $c->on_update ) { + $def .= ' ON UPDATE '.join( ' ', $c->on_update ); + } + + push @fks, "$def;"; + } + + return \@constraint_defs, \@fks; + } +} + +sub convert_datatype +{ + my ($field) = @_; + + my @size = $field->size; + my $data_type = lc $field->data_type; + + if ( $data_type eq 'enum' ) { +# my $len = 0; +# $len = ($len < length($_)) ? length($_) : $len for (@$list); +# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' ); +# push @$constraint_defs, +# qq[Constraint "$chk_name" CHECK ($qf$field_name$qf ]. +# qq[IN ($commalist))]; + $data_type = 'character varying'; + } + elsif ( $data_type eq 'set' ) { + $data_type = 'character varying'; + } + elsif ( $field->is_auto_increment ) { + if ( defined $size[0] && $size[0] > 11 ) { + $data_type = 'bigserial'; + } + else { + $data_type = 'serial'; + } + undef @size; + } + else { + $data_type = defined $translate{ $data_type } ? + $translate{ $data_type } : + $data_type; + } + + if ( $data_type =~ /timestamp/i ) { + if ( defined $size[0] && $size[0] > 6 ) { + $size[0] = 6; + } + } + + if ( $data_type eq 'integer' ) { + if ( defined $size[0] && $size[0] > 0) { + if ( $size[0] > 10 ) { + $data_type = 'bigint'; + } + elsif ( $size[0] < 5 ) { + $data_type = 'smallint'; + } + else { + $data_type = 'integer'; + } + } + else { + $data_type = 'integer'; + } + } + + # + # PG doesn't need a size for integers or text + # + undef @size if $data_type =~ m/(integer|smallint|bigint|text)/; + + if ( defined $size[0] && $size[0] > 0 ) { + $data_type .= '(' . join( ',', @size ) . ')'; + } + + + return $data_type; +} + + +sub alter_field +{ + my ($from_field, $to_field) = @_; + + die "Can't alter field in another table" + if($from_field->table->name ne $to_field->table->name); + + my @out; + push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL;', + $to_field->table->name, + $to_field->name) if(!$to_field->is_nullable and + $from_field->is_nullable); + + my $from_dt = convert_datatype($from_field); + my $to_dt = convert_datatype($to_field); + push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s;', + $to_field->table->name, + $to_field->name, + $to_dt) if($to_dt ne $from_dt); + + push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s;', + $to_field->table->name, + $from_field->name, + $to_field->name) if($from_field->name ne $to_field->name); + + push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s;', + $to_field->table->name, + $to_field->name, + $to_field->default_value) + if(defined $to_field->default_value && + $from_field->default_value ne $to_field->default_value); + + return wantarray ? @out : join("\n", @out); + +} + +sub add_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 ($old_field) = @_; + + my $out = sprintf('ALTER TABLE %s DROP COLUMN %s;', + $old_field->table->name, + $old_field->name); + + return $out; +} + 1; # ------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm index 2029efe..2ba8aff 100644 --- a/lib/SQL/Translator/Producer/SQLite.pm +++ b/lib/SQL/Translator/Producer/SQLite.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::SQLite; # ------------------------------------------------------------------- -# $Id: SQLite.pm,v 1.13 2005-07-05 16:20:43 mwz444 Exp $ +# $Id: SQLite.pm,v 1.14 2006-07-23 14:03:52 schiffbruechige Exp $ # ------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -44,7 +44,7 @@ use SQL::Translator::Utils qw(debug header_comment); use vars qw[ $VERSION $DEBUG $WARN ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; $WARN = 0 unless defined $WARN; @@ -67,162 +67,15 @@ sub produce { $create .= header_comment unless ($no_comments); $create .= "BEGIN TRANSACTION;\n\n"; - my ( @index_defs, @constraint_defs, @trigger_defs ); + my @table_defs = (); for my $table ( $schema->get_tables ) { - my $table_name = $table->name; - debug("PKG: Looking at table '$table_name'\n"); - - my @fields = $table->get_fields or die "No fields in $table_name"; - - # - # Header. - # - $create .= "--\n-- Table: $table_name\n--\n" unless $no_comments; - $create .= qq[DROP TABLE $table_name;\n] if $add_drop_table; - $create .= "CREATE TABLE $table_name (\n"; - - # - # Comments - # - if ( $table->comments and !$no_comments ){ - $create .= "-- Comments: \n-- "; - $create .= join "\n-- ", $table->comments; - $create .= "\n--\n\n"; - } - - # - # How many fields in PK? - # - my $pk = $table->primary_key; - my @pk_fields = $pk ? $pk->fields : (); - - # - # Fields - # - my ( @field_defs, $pk_set ); - for my $field ( @fields ) { - my $field_name = $field->name; - debug("PKG: Looking at field '$field_name'\n"); - my $field_comments = $field->comments - ? "-- " . $field->comments . "\n " - : ''; - - my $field_def = $field_comments.$field_name; - - # data type and size - my $size = $field->size; - my $data_type = $field->data_type; - $data_type = 'varchar' if lc $data_type eq 'set'; - $data_type = 'blob' if lc $data_type eq 'bytea'; - - if ( lc $data_type =~ /(text|blob)/i ) { - $size = undef; - } - - if ( $data_type =~ /timestamp/i ) { - push @trigger_defs, - "CREATE TRIGGER ts_${table_name} ". - "after insert on $table_name\n". - "begin\n". - " update $table_name set $field_name=timestamp() ". - "where id=new.id;\n". - "end;\n" - ; - - } - - # - # SQLite is generally typeless, but newer versions will - # make a field autoincrement if it is declared as (and - # *only* as) INTEGER PRIMARY KEY - # - if ( - $field->is_primary_key && - scalar @pk_fields == 1 && - ( - $data_type =~ /int(eger)?$/i - || - ( $data_type =~ /^number?$/i && $size !~ /,/ ) - ) - ) { - $data_type = 'INTEGER PRIMARY KEY'; - $size = undef; - $pk_set = 1; - } - - $field_def .= sprintf " %s%s", $data_type, - ( !$field->is_auto_increment && $size ) ? "($size)" : ''; - - # Null? - $field_def .= ' NOT NULL' unless $field->is_nullable; - - # Default? XXX Need better quoting! - my $default = $field->default_value; - if ( defined $default ) { - if ( uc $default eq 'NULL') { - $field_def .= ' DEFAULT NULL'; - } elsif ( $default eq 'now()' ) { - $field_def .= ' DEFAULT CURRENT_TIMESTAMP'; - } elsif ( $default =~ /val\(/ ) { - next; - } else { - $field_def .= " DEFAULT '$default'"; - } - } - - push @field_defs, $field_def; - } - - if ( - scalar @pk_fields > 1 - || - ( @pk_fields && !$pk_set ) - ) { - push @field_defs, 'PRIMARY KEY (' . join(', ', @pk_fields ) . ')'; - } - - # - # Indices - # - my $idx_name_default = 'A'; - for my $index ( $table->get_indices ) { - my $name = $index->name; - $name = mk_name($table_name, $name || ++$idx_name_default); - - # strip any field size qualifiers as SQLite doesn't like these - my @fields = map { s/\(\d+\)$//; $_ } $index->fields; - push @index_defs, - "CREATE INDEX $name on $table_name ". - '(' . join( ', ', @fields ) . ');'; - } - - # - # Constraints - # - my $c_name_default = 'A'; - for my $c ( $table->get_constraints ) { - next unless $c->type eq UNIQUE; - my $name = $c->name; - $name = mk_name($table_name, $name || ++$idx_name_default); - my @fields = $c->fields; - - push @constraint_defs, - "CREATE UNIQUE INDEX $name on $table_name ". - '(' . join( ', ', @fields ) . ');'; - } - - $create .= join(",\n", map { " $_" } @field_defs ) . "\n);\n"; - - $create .= "\n"; - } - - for my $def ( @index_defs, @constraint_defs, @trigger_defs ) { - $create .= "$def\n"; + push @table_defs, create_table($table, { no_comment => $no_comments, + add_drop_table => $add_drop_table,}); } - $create .= "COMMIT;\n"; +# $create .= "COMMIT;\n"; - return $create; + return wantarray ? ($create, @table_defs, "COMMIT;\n") : join("\n", ($create, @table_defs, "COMMIT;\n")); } # ------------------------------------------------------------------- @@ -260,9 +113,198 @@ sub mk_name { return $name; } -1; +sub create_table +{ + my ($table, $options) = @_; -# ------------------------------------------------------------------- + my $table_name = $table->name; + my $no_comments = $options->{no_comments}; + my $add_drop_table = $options->{add_drop_table}; + + debug("PKG: Looking at table '$table_name'\n"); + + my ( @index_defs, @constraint_defs, @trigger_defs ); + my @fields = $table->get_fields or die "No fields in $table_name"; + + # + # Header. + # + my $create = ''; + $create .= "--\n-- Table: $table_name\n--\n" unless $no_comments; + $create .= qq[DROP TABLE $table_name;\n] if $add_drop_table; + $create .= "CREATE TABLE $table_name (\n"; + + # + # Comments + # + if ( $table->comments and !$no_comments ){ + $create .= "-- Comments: \n-- "; + $create .= join "\n-- ", $table->comments; + $create .= "\n--\n\n"; + } + + # + # How many fields in PK? + # + my $pk = $table->primary_key; + my @pk_fields = $pk ? $pk->fields : (); + + # + # Fields + # + my ( @field_defs, $pk_set ); + for my $field ( @fields ) { + push @field_defs, create_field($field); + } + + if ( + scalar @pk_fields > 1 + || + ( @pk_fields && !grep /INTEGER PRIMARY KEY/, @field_defs ) + ) { + push @field_defs, 'PRIMARY KEY (' . join(', ', @pk_fields ) . ')'; + } + + # + # Indices + # + my $idx_name_default = 'A'; + for my $index ( $table->get_indices ) { + push @index_defs, create_index($index); + } + + # + # Constraints + # + my $c_name_default = 'A'; + for my $c ( $table->get_constraints ) { + next unless $c->type eq UNIQUE; + push @constraint_defs, create_constraint($c); + } + + $create .= join(",\n", map { " $_" } @field_defs ) . "\n);\n"; + + $create .= "\n"; + + for my $def ( @index_defs, @constraint_defs, @trigger_defs ) { + $create .= "$def\n"; + } + return $create; +} + +sub create_field +{ + my ($field, $options) = @_; + + my $field_name = $field->name; + debug("PKG: Looking at field '$field_name'\n"); + my $field_comments = $field->comments + ? "-- " . $field->comments . "\n " + : ''; + + my $field_def = $field_comments.$field_name; + + # data type and size + my $size = $field->size; + my $data_type = $field->data_type; + $data_type = 'varchar' if lc $data_type eq 'set'; + $data_type = 'blob' if lc $data_type eq 'bytea'; + + if ( lc $data_type =~ /(text|blob)/i ) { + $size = undef; + } + +# if ( $data_type =~ /timestamp/i ) { +# push @trigger_defs, +# "CREATE TRIGGER ts_${table_name} ". +# "after insert on $table_name\n". +# "begin\n". +# " update $table_name set $field_name=timestamp() ". +# "where id=new.id;\n". +# "end;\n" +# ; +# +# } + + # + # SQLite is generally typeless, but newer versions will + # make a field autoincrement if it is declared as (and + # *only* as) INTEGER PRIMARY KEY + # + my $pk = $field->table->primary_key; + my @pk_fields = $pk ? $pk->fields : (); + + if ( + $field->is_primary_key && + scalar @pk_fields == 1 && + ( + $data_type =~ /int(eger)?$/i + || + ( $data_type =~ /^number?$/i && $size !~ /,/ ) + ) + ) { + $data_type = 'INTEGER PRIMARY KEY'; + $size = undef; +# $pk_set = 1; + } + + $field_def .= sprintf " %s%s", $data_type, + ( !$field->is_auto_increment && $size ) ? "($size)" : ''; + + # Null? + $field_def .= ' NOT NULL' unless $field->is_nullable; + + # Default? XXX Need better quoting! + my $default = $field->default_value; + if ( defined $default ) { + if ( uc $default eq 'NULL') { + $field_def .= ' DEFAULT NULL'; + } elsif ( $default eq 'now()' || + $default eq 'CURRENT_TIMESTAMP' ) { + $field_def .= ' DEFAULT CURRENT_TIMESTAMP'; + } elsif ( $default =~ /val\(/ ) { + next; + } else { + $field_def .= " DEFAULT '$default'"; + } + } + + return $field_def; + +} + +sub create_index +{ + my ($index, $options) = @_; + + my $name = $index->name; + $name = mk_name($index->table->name, $name); # || ++$idx_name_default); + + # strip any field size qualifiers as SQLite doesn't like these + my @fields = map { s/\(\d+\)$//; $_ } $index->fields; + my $index_def = + "CREATE INDEX $name on " . $index->table->name . + ' (' . join( ', ', @fields ) . ');'; + + return $index_def; +} + +sub create_constraint +{ + my ($c, $options) = @_; + + my $name = $c->name; + $name = mk_name($c->table->name, $name); # || ++$idx_name_default); + my @fields = $c->fields; + + my $c_def = + "CREATE UNIQUE INDEX $name on " . $c->table->name . + ' (' . join( ', ', @fields ) . ');'; + + return $c_def; +} + +1; =pod