X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FSQLite.pm;h=5ac49b807994c21198c2d259d30270655c35ad3e;hb=ea4a3ecc5de1c8f062fef3bab51e1cc7a2c23235;hp=a65043d93c667221463861b7e5928a6b97368f1c;hpb=ecf7f25dc6c635164c957607e122da978662040e;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm index a65043d..5ac49b8 100644 --- a/lib/SQL/Translator/Producer/SQLite.pm +++ b/lib/SQL/Translator/Producer/SQLite.pm @@ -1,25 +1,5 @@ package SQL::Translator::Producer::SQLite; -# ------------------------------------------------------------------- -# $Id: SQLite.pm,v 1.15 2006-08-26 11:35:31 schiffbruechige Exp $ -# ------------------------------------------------------------------- -# Copyright (C) 2002-4 SQLFairy Authors -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as -# published by the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -# 02111-1307 USA -# ------------------------------------------------------------------- - =head1 NAME SQL::Translator::Producer::SQLite - SQLite producer for SQL::Translator @@ -38,20 +18,20 @@ This module will produce text output of the schema suitable for SQLite. =cut use strict; +use warnings; use Data::Dumper; use SQL::Translator::Schema::Constants; -use SQL::Translator::Utils qw(debug header_comment); - -use vars qw[ $VERSION $DEBUG $WARN ]; +use SQL::Translator::Utils qw(debug header_comment parse_dbms_version); +use SQL::Translator::ProducerUtils; +my $util = SQL::Translator::ProducerUtils->new( quote_chars => q(') ); -$VERSION = sprintf "%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/; +our ( $DEBUG, $WARN ); +our $VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; $WARN = 0 unless defined $WARN; -my %used_identifiers = (); -my $max_id_length = 30; +our $max_id_length = 30; my %global_names; -my %truncated; sub produce { my $translator = shift; @@ -60,51 +40,64 @@ sub produce { my $no_comments = $translator->no_comments; my $add_drop_table = $translator->add_drop_table; my $schema = $translator->schema; + my $producer_args = $translator->producer_args; + my $sqlite_version = parse_dbms_version( + $producer_args->{sqlite_version}, 'perl' + ); + my $no_txn = $producer_args->{no_transaction}; debug("PKG: Beginning production\n"); - my $create = ''; - $create .= header_comment unless ($no_comments); - $create .= "BEGIN TRANSACTION;\n\n"; + %global_names = (); #reset + + + my $head = (header_comment() . "\n") unless $no_comments; + + my @create = (); + + push @create, "BEGIN TRANSACTION" unless $no_txn; - my @table_defs = (); for my $table ( $schema->get_tables ) { - my @defs = create_table($table, { no_comments => $no_comments, + push @create, create_table($table, { no_comments => $no_comments, + sqlite_version => $sqlite_version, add_drop_table => $add_drop_table,}); - my $create = shift @defs; - $create .= ";\n"; - push @table_defs, $create, map( { "$_;" } @defs), ""; } -# $create .= "COMMIT;\n"; + for my $view ( $schema->get_views ) { + push @create, create_view($view, { + add_drop_view => $add_drop_table, + no_comments => $no_comments, + }); + } + + for my $trigger ( $schema->get_triggers ) { + push @create, create_trigger($trigger, { + add_drop_trigger => $add_drop_table, + no_comments => $no_comments, + }); + } + + push @create, "COMMIT" unless $no_txn; - return wantarray ? ($create, @table_defs, "COMMIT;\n") : join("\n", ($create, @table_defs, "COMMIT;\n")); + if (wantarray) { + return ($head||(), @create); + } else { + return join ('', + $head||(), + join(";\n\n", @create ), + ";\n", + ); + } } -# ------------------------------------------------------------------- sub mk_name { - my ($basename, $type, $scope, $critical) = @_; - my $basename_orig = $basename; - my $max_name = $type - ? $max_id_length - (length($type) + 1) - : $max_id_length; - $basename = substr( $basename, 0, $max_name ) - if length( $basename ) > $max_name; - $basename =~ s/\./_/g; - my $name = $type ? "${type}_$basename" : $basename; - - if ( $basename ne $basename_orig and $critical ) { - my $show_type = $type ? "+'$type'" : ""; - warn "Truncating '$basename_orig'$show_type to $max_id_length ", - "character limit to make '$name'\n" if $WARN; - $truncated{ $basename_orig } = $name; - } + my ($name, $scope, $critical) = @_; $scope ||= \%global_names; if ( my $prev = $scope->{ $name } ) { my $name_orig = $name; $name .= sprintf( "%02d", ++$prev ); - substr($name, $max_id_length - 3) = "00" + substr($name, $max_id_length - 3) = "00" if length( $name ) > $max_id_length; warn "The name '$name_orig' has been changed to ", @@ -114,38 +107,82 @@ sub mk_name { } $scope->{ $name }++; - return $name; + return $util->quote($name); } +sub create_view { + my ($view, $options) = @_; + my $add_drop_view = $options->{add_drop_view}; + + my $view_name = $util->quote($view->name); + $global_names{$view->name} = 1; + + debug("PKG: Looking at view '${view_name}'\n"); + + # Header. Should this look like what mysqldump produces? + my $extra = $view->extra; + my @create; + push @create, "DROP VIEW IF EXISTS $view_name" if $add_drop_view; + + my $create_view = 'CREATE'; + $create_view .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary}; + $create_view .= ' VIEW'; + $create_view .= " IF NOT EXISTS" if exists($extra->{if_not_exists}) && $extra->{if_not_exists}; + $create_view .= " ${view_name}"; + + if( my $sql = $view->sql ){ + $create_view .= " AS\n ${sql}"; + } + push @create, $create_view; + + # Tack the comment onto the first statement. + unless ($options->{no_comments}) { + $create[0] = "--\n-- View: ${view_name}\n--\n" . $create[0]; + } + + return @create; +} + + sub create_table { my ($table, $options) = @_; - my $table_name = $table->name; + my $table_name = $util->quote($table->name); + $global_names{$table->name} = 1; + my $no_comments = $options->{no_comments}; my $add_drop_table = $options->{add_drop_table}; + my $sqlite_version = $options->{sqlite_version} || 0; debug("PKG: Looking at table '$table_name'\n"); - my ( @index_defs, @constraint_defs, @trigger_defs ); + my ( @index_defs, @constraint_defs ); my @fields = $table->get_fields or die "No fields in $table_name"; my $temp = $options->{temporary_table} ? 'TEMPORARY ' : ''; # # 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 ${temp}TABLE $table_name (\n"; + my $exists = ($sqlite_version >= 3.003) ? ' IF EXISTS' : ''; + my @create; + my ($comment, $create_table) = ""; + $comment = "--\n-- Table: $table_name\n--\n" unless $no_comments; + if ($add_drop_table) { + push @create, $comment . qq[DROP TABLE$exists $table_name]; + } else { + $create_table = $comment; + } + + $create_table .= "CREATE ${temp}TABLE $table_name (\n"; # # Comments # if ( $table->comments and !$no_comments ){ - $create .= "-- Comments: \n-- "; - $create .= join "\n-- ", $table->comments; - $create .= "\n--\n\n"; + $create_table .= "-- Comments: \n-- "; + $create_table .= join "\n-- ", $table->comments; + $create_table .= "\n--\n\n"; } # @@ -162,12 +199,12 @@ sub create_table push @field_defs, create_field($field); } - if ( - scalar @pk_fields > 1 - || - ( @pk_fields && !grep /INTEGER PRIMARY KEY/, @field_defs ) + if ( + scalar @pk_fields > 1 + || + ( @pk_fields && !grep /INTEGER PRIMARY KEY/, @field_defs ) ) { - push @field_defs, 'PRIMARY KEY (' . join(', ', @pk_fields ) . ')'; + push @field_defs, 'PRIMARY KEY (' . join(', ', map $util->quote($_), @pk_fields ) . ')'; } # @@ -183,23 +220,56 @@ sub create_table # my $c_name_default = 'A'; for my $c ( $table->get_constraints ) { - next unless $c->type eq UNIQUE; + if ($c->type eq "FOREIGN KEY") { + push @field_defs, create_foreignkey($c); + } + next unless $c->type eq UNIQUE; push @constraint_defs, create_constraint($c); } - $create .= join(",\n", map { " $_" } @field_defs ) . "\n)"; + $create_table .= join(",\n", map { " $_" } @field_defs ) . "\n)"; - return ($create, @index_defs, @constraint_defs, @trigger_defs ); + return (@create, $create_table, @index_defs, @constraint_defs ); +} + +sub create_foreignkey { + my $c = shift; + + my @fields = $c->fields; + my @rfields = map { $_ || () } $c->reference_fields; + unless ( @rfields ) { + my $rtable_name = $c->reference_table; + if ( my $ref_table = $c->schema->get_table( $rtable_name ) ) { + push @rfields, $ref_table->primary_key; + + die "FK constraint on " . $rtable_name . '.' . join('', @fields) . " has no reference fields\n" + unless @rfields; + } + else { + die "Can't find reference table '$rtable_name' in schema\n"; + } + } + + my $fk_sql = sprintf 'FOREIGN KEY (%s) REFERENCES %s(%s)', + join (', ', map { $util->quote($_) } @fields ), + $util->quote($c->reference_table), + join (', ', map { $util->quote($_) } @rfields ) + ; + + $fk_sql .= " ON DELETE " . $c->{on_delete} if $c->{on_delete}; + $fk_sql .= " ON UPDATE " . $c->{on_update} if $c->{on_update}; + + return $fk_sql; } sub create_field { my ($field, $options) = @_; - my $field_name = $field->name; + my $field_name = $util->quote($field->name); debug("PKG: Looking at field '$field_name'\n"); - my $field_comments = $field->comments - ? "-- " . $field->comments . "\n " + my $field_comments = $field->comments + ? "-- " . $field->comments . "\n " : ''; my $field_def = $field_comments.$field_name; @@ -215,7 +285,7 @@ sub create_field } # if ( $data_type =~ /timestamp/i ) { -# push @trigger_defs, +# push @trigger_defs, # "CREATE TRIGGER ts_${table_name} ". # "after insert on $table_name\n". # "begin\n". @@ -234,8 +304,8 @@ sub create_field my $pk = $field->table->primary_key; my @pk_fields = $pk ? $pk->fields : (); - if ( - $field->is_primary_key && + if ( + $field->is_primary_key && scalar @pk_fields == 1 && ( $data_type =~ /int(eger)?$/i @@ -248,26 +318,22 @@ sub create_field # $pk_set = 1; } - $field_def .= sprintf " %s%s", $data_type, + $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'"; - } - } + # Default? + SQL::Translator::Producer->_apply_default_value( + $field, + \$field_def, + [ + 'NULL' => \'NULL', + 'now()' => 'now()', + 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP', + ], + ); return $field_def; @@ -278,15 +344,16 @@ sub create_index my ($index, $options) = @_; my $name = $index->name; - $name = mk_name($index->table->name, $name); + $name = mk_name($name); - my $type = $index->type eq 'UNIQUE' ? "UNIQUE " : ''; + my $type = $index->type eq 'UNIQUE' ? "UNIQUE " : ''; # strip any field size qualifiers as SQLite doesn't like these - my @fields = map { s/\(\d+\)$//; $_ } $index->fields; + my @fields = map { s/\(\d+\)$//; $util->quote($_) } $index->fields; (my $index_table_name = $index->table->name) =~ s/^.+?\.//; # table name may not specify schema + $index_table_name = $util->quote($index_table_name); warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN; - my $index_def = + my $index_def = "CREATE ${type}INDEX $name ON " . $index_table_name . ' (' . join( ', ', @fields ) . ')'; @@ -298,25 +365,82 @@ sub create_constraint my ($c, $options) = @_; my $name = $c->name; - $name = mk_name($c->table->name, $name); - my @fields = $c->fields; + $name = mk_name($name); + my @fields = map $util->quote($_), $c->fields; (my $index_table_name = $c->table->name) =~ s/^.+?\.//; # table name may not specify schema + $index_table_name = $util->quote($index_table_name); warn "removing schema name from '" . $c->table->name . "' to make '$index_table_name'\n" if $WARN; - my $c_def = + my $c_def = "CREATE UNIQUE INDEX $name ON " . $index_table_name . ' (' . join( ', ', @fields ) . ')'; return $c_def; } +sub create_trigger { + my ($trigger, $options) = @_; + my $add_drop = $options->{add_drop_trigger}; + + my @statements; + + my $trigger_name = $trigger->name; + $global_names{$trigger_name} = 1; + + my $events = $trigger->database_events; + for my $evt ( @$events ) { + + my $trig_name = $trigger_name; + if (@$events > 1) { + $trig_name .= "_$evt"; + + warn "Multiple database events supplied for trigger '$trigger_name', ", + "creating trigger '$trig_name' for the '$evt' event.\n" if $WARN; + } + + $trig_name = $util->quote($trig_name); + push @statements, "DROP TRIGGER IF EXISTS $trig_name" if $add_drop; + + + $DB::single = 1; + my $action = ""; + if (not ref $trigger->action) { + $action .= "BEGIN " . $trigger->action . " END"; + } + else { + $action = $trigger->action->{for_each} . " " + if $trigger->action->{for_each}; + + $action = $trigger->action->{when} . " " + if $trigger->action->{when}; + + my $steps = $trigger->action->{steps} || []; + + $action .= "BEGIN "; + $action .= $_ . "; " for (@$steps); + $action .= "END"; + } + + push @statements, sprintf ( + 'CREATE TRIGGER %s %s %s on %s %s', + $trig_name, + $trigger->perform_action_when, + $evt, + $util->quote($trigger->on_table), + $action + ); + } + + return @statements; +} + sub alter_table { } # Noop sub add_field { my ($field) = @_; return sprintf("ALTER TABLE %s ADD COLUMN %s", - $field->table->name, create_field($field)) + $util->quote($field->table->name), create_field($field)) } sub alter_create_index { @@ -338,7 +462,7 @@ sub alter_drop_index { my ($constraint) = @_; return sprintf("DROP INDEX %s", - $constraint->name); + $util->quote($constraint->name)); } sub batch_alter_table { @@ -372,11 +496,12 @@ sub batch_alter_table { @{$diffs->{alter_field}} == 0 && @{$diffs->{drop_field}} == 0 ) { - return join("\n", map { +# return join("\n", map { + return map { my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_"; - map { my $sql = $meth->(ref $_ eq 'ARRAY' ? @$_ : $_); $sql ? ("$sql;") : () } @{ $diffs->{$_} } - - } grep { @{$diffs->{$_}} } + map { my $sql = $meth->(ref $_ eq 'ARRAY' ? @$_ : $_); $sql ? ("$sql") : () } @{ $diffs->{$_} } + + } grep { @{$diffs->{$_}} } qw/rename_table alter_drop_constraint alter_drop_index @@ -386,13 +511,13 @@ sub batch_alter_table { rename_field alter_create_index alter_create_constraint - alter_table/); + alter_table/; } my @sql; my $old_table = $renaming ? $diffs->{rename_table}[0][0] : $table; - + do { local $table->{name} = $table_name . '_temp_alter'; # We only want the table - dont care about indexes on tmp table @@ -400,26 +525,29 @@ sub batch_alter_table { push @sql,$table_sql; }; - push @sql, "INSERT INTO @{[$table_name]}_temp_alter SELECT @{[ join(', ', $old_table->get_fields)]} FROM @{[$old_table]}", - "DROP TABLE @{[$old_table]}", + push @sql, "INSERT INTO @{[$util->quote($table_name.'_temp_alter')]} SELECT @{[ join(', ', map $util->quote($_), $old_table->get_fields)]} FROM @{[$util->quote($old_table)]}", + "DROP TABLE @{[$util->quote($old_table)]}", create_table($table, { no_comments => 1 }), - "INSERT INTO @{[$table_name]} SELECT @{[ join(', ', $old_table->get_fields)]} FROM @{[$table_name]}_temp_alter", - "DROP TABLE @{[$table_name]}_temp_alter"; + "INSERT INTO @{[$util->quote($table_name)]} SELECT @{[ join(', ', map $util->quote($_), $old_table->get_fields)]} FROM @{[$util->quote($table_name.'_temp_alter')]}", + "DROP TABLE @{[$util->quote($table_name.'_temp_alter')]}"; - return join(";\n", @sql, ""); + return @sql; +# return join("", @sql, ""); } sub drop_table { my ($table) = @_; - return "DROP TABLE $table;"; + $table = $util->quote($table); + return "DROP TABLE $table"; } sub rename_table { my ($old_table, $new_table, $options) = @_; - my $qt = $options->{quote_table_names} || ''; + $old_table = $util->quote($old_table); + $new_table = $util->quote($new_table); - return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt"; + return "ALTER TABLE $old_table RENAME TO $new_table"; } @@ -436,7 +564,7 @@ SQL::Translator, http://www.sqlite.org/. =head1 AUTHOR -Ken Y. Clark C<< >>. +Ken Youens-Clark C<< >>. Diff code added by Ash Berlin C<< >>.