From 8fb9a6f784887cbd6dd287dbcbf3da125a9271e0 Mon Sep 17 00:00:00 2001 From: Rob Kinyon Date: Wed, 16 Sep 2015 09:47:00 -0400 Subject: [PATCH 1/3] Add deferred FKs to SQLite --- Makefile.PL | 2 +- lib/SQL/Translator/Parser/SQLite.pm | 13 ++++++++++++- lib/SQL/Translator/Producer/SQLite.pm | 1 + t/30sqlt-new-diff-sqlite.t | 4 ++-- t/48xml-to-sqlite.t | 4 ++-- t/56-sqlite-producer.t | 2 +- 6 files changed, 19 insertions(+), 7 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 9b2418ac5..a3bbac8cc 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -54,7 +54,7 @@ resources IRC => 'irc://irc.perl.org/#sql-translator'; Meta->{values}{x_authority} = 'cpan:JROBINSON'; all_from 'lib/SQL/Translator.pm'; -readme_from 'lib/SQL/Translator.pm'; +#readme_from 'lib/SQL/Translator.pm'; for my $type (qw/requires recommends test_requires/) { no strict qw/refs/; diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index 478730267..ae9f4a812 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/lib/SQL/Translator/Parser/SQLite.pm @@ -425,7 +425,7 @@ table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?) } } | - FOREIGN_KEY parens_field_list REFERENCES ref_def cascade_def(?) + FOREIGN_KEY parens_field_list REFERENCES ref_def cascade_def(?) deferrable(?) deferred(?) { $return = { supertype => 'constraint', @@ -435,6 +435,8 @@ table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?) reference_fields => $item[4]{'reference_fields'}, on_delete => $item[5][0]{'on_delete'}, on_update => $item[5][0]{'on_update'}, + deferrable => $item[6] && ($item[7]||'') eq 'deferred', + #deferred => $item[6] && ($item[7]||'') eq 'deferred', } } @@ -453,6 +455,15 @@ cascade_delete_def : /on\s+delete\s+(set null|set default|cascade|restrict|no ac cascade_update_def : /on\s+update\s+(set null|set default|cascade|restrict|no action)/i { $return = $1} +not : /not/i + +deferrable : not(?) /deferrable/i + { + $return = ( $item[1] =~ /not/i ) ? 0 : 1; + } + +deferred : /initially/i /(deferred|immediate)/i { $item[2] } + table_name : qualified_name qualified_name : NAME diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm index 9cc92aff7..1296b1785 100644 --- a/lib/SQL/Translator/Producer/SQLite.pm +++ b/lib/SQL/Translator/Producer/SQLite.pm @@ -282,6 +282,7 @@ sub create_foreignkey { $fk_sql .= " ON DELETE " . $c->{on_delete} if $c->{on_delete}; $fk_sql .= " ON UPDATE " . $c->{on_update} if $c->{on_update}; + $fk_sql .= " DEFERRABLE INITIALLY DEFERRED" if $c->deferrable; return $fk_sql; } diff --git a/t/30sqlt-new-diff-sqlite.t b/t/30sqlt-new-diff-sqlite.t index 34f6fb1c4..8f9a00218 100644 --- 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) DEFERRABLE INITIALLY DEFERRED ); INSERT INTO employee_temp_alter( position, employee_id) 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) DEFERRABLE INITIALLY DEFERRED ); 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 21e8ad355..dfc84b67a 100644 --- a/t/48xml-to-sqlite.t +++ b/t/48xml-to-sqlite.t @@ -50,7 +50,7 @@ CREATE TABLE "Basic" ( "emptytagdef" varchar DEFAULT '', "another_id" int(10) DEFAULT 2, "timest" timestamp, - FOREIGN KEY ("another_id") REFERENCES "Another"("id") + FOREIGN KEY ("another_id") REFERENCES "Another"("id") DEFERRABLE INITIALLY DEFERRED ); CREATE INDEX "titleindex" ON "Basic" ("title"); @@ -108,7 +108,7 @@ eq_or_diff(\@sql, "emptytagdef" varchar DEFAULT '', "another_id" int(10) DEFAULT 2, "timest" timestamp, - FOREIGN KEY ("another_id") REFERENCES "Another"("id") + FOREIGN KEY ("another_id") REFERENCES "Another"("id") DEFERRABLE INITIALLY DEFERRED )>, q, q, diff --git a/t/56-sqlite-producer.t b/t/56-sqlite-producer.t index d0d2cfeb2..8cebcb394 100644 --- a/t/56-sqlite-producer.t +++ b/t/56-sqlite-producer.t @@ -57,7 +57,7 @@ $SQL::Translator::Producer::SQLite::NO_QUOTES = 0; on_delete => 'RESTRICT', on_update => 'CASCADE', ); - my $expected = [ 'FOREIGN KEY ("foreign_key") REFERENCES "foo"("id") ON DELETE RESTRICT ON UPDATE CASCADE']; + my $expected = [ 'FOREIGN KEY ("foreign_key") REFERENCES "foo"("id") ON DELETE RESTRICT ON UPDATE CASCADE DEFERRABLE INITIALLY DEFERRED']; my $result = [SQL::Translator::Producer::SQLite::create_foreignkey($constraint,$create_opts)]; is_deeply($result, $expected, 'correct "FOREIGN KEY"'); } From acfc76ba4fce0cf3a32120bc64a47578ba317d37 Mon Sep 17 00:00:00 2001 From: Rob Kinyon Date: Wed, 16 Sep 2015 09:48:33 -0400 Subject: [PATCH 2/3] Unrevert Makefile.PL change --- Makefile.PL | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.PL b/Makefile.PL index a3bbac8cc..9b2418ac5 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -54,7 +54,7 @@ resources IRC => 'irc://irc.perl.org/#sql-translator'; Meta->{values}{x_authority} = 'cpan:JROBINSON'; all_from 'lib/SQL/Translator.pm'; -#readme_from 'lib/SQL/Translator.pm'; +readme_from 'lib/SQL/Translator.pm'; for my $type (qw/requires recommends test_requires/) { no strict qw/refs/; From 82090301dae9e603d2a0b7d25cabb42d0023bb79 Mon Sep 17 00:00:00 2001 From: Rob Kinyon Date: Wed, 16 Sep 2015 15:51:33 -0400 Subject: [PATCH 3/3] Fix SQLite parser definition to better map to SQLite requirements --- lib/SQL/Translator/Parser/SQLite.pm | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index ae9f4a812..f241a097b 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/lib/SQL/Translator/Parser/SQLite.pm @@ -425,7 +425,7 @@ table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?) } } | - FOREIGN_KEY parens_field_list REFERENCES ref_def cascade_def(?) deferrable(?) deferred(?) + FOREIGN_KEY parens_field_list REFERENCES ref_def cascade_def(?) deferrable(?) { $return = { supertype => 'constraint', @@ -435,8 +435,7 @@ table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?) reference_fields => $item[4]{'reference_fields'}, on_delete => $item[5][0]{'on_delete'}, on_update => $item[5][0]{'on_update'}, - deferrable => $item[6] && ($item[7]||'') eq 'deferred', - #deferred => $item[6] && ($item[7]||'') eq 'deferred', + deferrable => $item[6], } } @@ -457,13 +456,12 @@ cascade_update_def : /on\s+update\s+(set null|set default|cascade|restrict|no ac not : /not/i -deferrable : not(?) /deferrable/i +deferrable_initially : /initially (deferred|immediate)/i +deferrable : not(?) /deferrable/i deferrable_initially(?) { - $return = ( $item[1] =~ /not/i ) ? 0 : 1; + $return = $item[1] || !$item[3] || $item[3] ne 'initially deferred' ? 0 : 1 } -deferred : /initially/i /(deferred|immediate)/i { $item[2] } - table_name : qualified_name qualified_name : NAME