Combined patches from RT#70734 and RT#44769

diff --git a/Changes b/Changes
index efc9868..9d08e58 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
 * All parser grammars are now precompiled for speed
+* Fixes to SQLite foreign keys production (patch from Johan Viklund)
+  closes RT#16412, RT#44769
+* ON DELETE/UPDATE actions for SQLite (patch from Lukas Thiemeier)
+  closes RT#70734, RT#71283, RT#70378
 * Proper quoting support in SQLite
 * Support for triggers in PostgreSQL producer and parser
 * Correct Data Type in SQLT::Parser::DBI::PostgreSQL (patch from Andrew Pam)

diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm
index 95c1814..259c0cf 100644 (file)
--- a/lib/SQL/Translator/Parser/SQLite.pm
+++ b/lib/SQL/Translator/Parser/SQLite.pm
@@ -360,12 +360,14 @@ column_constraint : NOT_NULL conflict_clause(?)
         }
     }
     |
-    REFERENCES ref_def
+    REFERENCES ref_def cascade_def(?)
     {
         $return   = {
             type             => 'foreign_key',
             reference_table  => $item[2]{'reference_table'},
             reference_fields => $item[2]{'reference_fields'},
+            on_delete        => $item[3][0]{'on_delete'},
+            on_update        => $item[3][0]{'on_update'},
         }
     }
     |
@@ -423,7 +425,7 @@ table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?)
         }
     }
     |
-    FOREIGN_KEY parens_field_list REFERENCES ref_def
+    FOREIGN_KEY parens_field_list REFERENCES ref_def cascade_def(?)
     {
       $return = {
         supertype        => 'constraint',
@@ -431,12 +433,26 @@ table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?)
         fields           => $item[2],
         reference_table  => $item[4]{'reference_table'},
         reference_fields => $item[4]{'reference_fields'},
+        on_delete        => $item[5][0]{'on_delete'},
+        on_update        => $item[5][0]{'on_update'},
       }
     }
 
 ref_def : table_name parens_field_list
     { $return = { reference_table => $item[1]{name}, reference_fields => $item[2] } }
 
+cascade_def : cascade_update_def cascade_delete_def(?)
+    { $return = {  on_update => $item[1], on_delete => $item[2][0] } }
+    |
+    cascade_delete_def cascade_update_def(?)
+    { $return = {  on_delete => $item[1], on_update => $item[2][0] } }
+
+cascade_delete_def : /on\s+delete\s+(\w+)/i
+    { $return = $1}
+
+cascade_update_def : /on\s+update\s+(\w+)/i
+    { $return = $1}
+
 table_name : qualified_name
 
 qualified_name : NAME

diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm
index f3e3620..5ac49b8 100644 (file)
--- a/lib/SQL/Translator/Producer/SQLite.pm
+++ b/lib/SQL/Translator/Producer/SQLite.pm
@@ -235,11 +235,29 @@ sub create_table
 sub create_foreignkey {
     my $c = shift;
 
-    my $field = $util->quote($c->{fields}[0]);
-    my $table = $c->{reference_table} ? $util->quote($c->{reference_table}) : '';
-    my $ref   = $c->{reference_fields}[0] ? $util->quote($c->{reference_fields}[0]) : '';
-    my $fk_sql = "FOREIGN KEY($field) REFERENCES ";
-    $fk_sql .= "$table($ref)";
+    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;
 }

diff --git a/t/27sqlite-parser.t b/t/27sqlite-parser.t
index 0d2abf0..ae99f19 100644 (file)
--- a/t/27sqlite-parser.t
+++ b/t/27sqlite-parser.t
@@ -10,7 +10,7 @@ use SQL::Translator;
 use SQL::Translator::Schema::Constants;
 
 BEGIN {
-    maybe_plan(19,
+    maybe_plan(21,
         'SQL::Translator::Parser::SQLite');
 }
 SQL::Translator::Parser::SQLite->import('parse');
@@ -80,6 +80,8 @@ $file = "$Bin/data/sqlite/named.sql";
     is( $c1->type, 'FOREIGN KEY', 'FK constraint' );
     is( $c1->reference_table, 'person', 'References person table' );
     is( $c1->name, 'fk_person_id', 'Constraint name fk_person_id' );
+    is( $c1->on_delete, 'RESTRICT', 'On delete restrict' );
+    is( $c1->on_update, 'CASCADE', 'On update cascade' );
     is( join(',', $c1->reference_fields), 'person_id',
         'References person_id field' );
 

diff --git a/t/30sqlt-new-diff-sqlite.t b/t/30sqlt-new-diff-sqlite.t
index 4503d6e..c6b4b92 100644 (file)
--- a/t/30sqlt-new-diff-sqlite.t
+++ b/t/30sqlt-new-diff-sqlite.t
@@ -99,7 +99,7 @@ CREATE TEMPORARY TABLE 'employee_temp_alter' (
   'position' varchar(50) NOT NULL,
   'employee_id' int(11) NOT NULL,
   PRIMARY KEY ('position', 'employee_id'),
-  FOREIGN KEY('employee_id') REFERENCES 'person'('person_id')
+  FOREIGN KEY ('employee_id') REFERENCES 'person'('person_id')
 );
 
 INSERT INTO 'employee_temp_alter' SELECT 'position', 'employee_id' FROM 'employee';
@@ -110,7 +110,7 @@ CREATE TABLE 'employee' (
   'position' varchar(50) NOT NULL,
   'employee_id' int(11) NOT NULL,
   PRIMARY KEY ('position', 'employee_id'),
-  FOREIGN KEY('employee_id') REFERENCES 'person'('person_id')
+  FOREIGN KEY ('employee_id') REFERENCES 'person'('person_id')
 );
 
 INSERT INTO 'employee' SELECT 'position', 'employee_id' FROM 'employee_temp_alter';

diff --git a/t/48xml-to-sqlite.t b/t/48xml-to-sqlite.t
index 9d0baa4..c567bbc 100644 (file)
--- a/t/48xml-to-sqlite.t
+++ b/t/48xml-to-sqlite.t
@@ -49,7 +49,7 @@ CREATE TABLE 'Basic' (
   'emptytagdef' varchar DEFAULT '',
   'another_id' int(10) DEFAULT 2,
   'timest' timestamp,
-  FOREIGN KEY('another_id') REFERENCES 'Another'()
+  FOREIGN KEY ('another_id') REFERENCES 'Another'('id')
 );
 
 CREATE INDEX 'titleindex' ON 'Basic' ('title');
@@ -107,7 +107,7 @@ eq_or_diff(\@sql,
   'emptytagdef' varchar DEFAULT '',
   'another_id' int(10) DEFAULT 2,
   'timest' timestamp,
-  FOREIGN KEY('another_id') REFERENCES 'Another'()
+  FOREIGN KEY ('another_id') REFERENCES 'Another'('id')
 )>,
           q<CREATE INDEX 'titleindex' ON 'Basic' ('title')>,
           q<CREATE UNIQUE INDEX 'emailuniqueindex' ON 'Basic' ('email')>,

diff --git a/t/56-sqlite-producer.t b/t/56-sqlite-producer.t
index e01d2b1..752559d 100644 (file)
--- a/t/56-sqlite-producer.t
+++ b/t/56-sqlite-producer.t
@@ -2,11 +2,12 @@
 # vim: set ft=perl:
 
 use strict;
-use Test::More tests => 2;
+use Test::More tests => 3;
 use Test::SQL::Translator qw(maybe_plan);
 use FindBin qw/$Bin/;
 
 use SQL::Translator::Schema::View;
+use SQL::Translator::Schema::Table;
 use SQL::Translator::Producer::SQLite;
 
 {
@@ -34,3 +35,28 @@ use SQL::Translator::Producer::SQLite;
     SELECT id, name FROM thing" ];
   is_deeply($view1_sql2, $view_sql_noreplace, 'correct "CREATE VIEW" SQL');
 }
+{
+    my $create_opts;
+
+    my $table = SQL::Translator::Schema::Table->new(
+        name => 'foo_table',
+    );
+    $table->add_field(
+        name => 'foreign_key',
+        data_type => 'integer',
+    );
+    my $constraint = SQL::Translator::Schema::Constraint->new(
+        table => $table,
+        name => 'fk',
+        type => 'FOREIGN_KEY',
+        fields => ['foreign_key'],
+        reference_fields => ['id'],
+        reference_table => 'foo',
+        on_delete => 'RESTRICT',
+        on_update => 'CASCADE',
+    );
+
+    my $expected = [ "FOREIGN KEY ('foreign_key') REFERENCES 'foo'('id') ON DELETE RESTRICT ON UPDATE CASCADE"];
+    my $result =  [SQL::Translator::Producer::SQLite::create_foreignkey($constraint,$create_opts)];
+    is_deeply($result, $expected, 'correct "FOREIGN KEY"');
+}

diff --git a/t/data/sqlite/named.sql b/t/data/sqlite/named.sql
index 7e93878..fdc1f98 100644 (file)
--- a/t/data/sqlite/named.sql
+++ b/t/data/sqlite/named.sql
@@ -1,7 +1,7 @@
 create table pet (
   "pet_id" int,
   "person_id" int
-    constraint fk_person_id references person(person_id),
+    constraint fk_person_id references person(person_id) on update CASCADE on delete RESTRICT,
   "name" varchar(30),
   "age" int,
   constraint age_under_100 check ( age < 100 ),