SQLite parser: handle named constraints, and don't choke on a comment

before a table constraint.

diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm
index c4c2fe1..55f6e8d 100644 (file)
--- a/lib/SQL/Translator/Parser/SQLite.pm
+++ b/lib/SQL/Translator/Parser/SQLite.pm
@@ -271,7 +271,7 @@ create : CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLO
 
 definition : constraint_def | column_def 
 
-column_def: comment(s?) NAME type(?) column_constraint(s?)
+column_def: comment(s?) NAME type(?) column_constraint_def(s?)
     {
         my $column = {
             supertype      => 'column',
@@ -320,6 +320,16 @@ type : WORD parens_value_list(?)
         }
     }
 
+column_constraint_def : CONSTRAINT constraint_name column_constraint
+    {
+        $return = {
+            name => $item[2],
+            %{ $item[3] },
+        }
+    }
+    |
+    column_constraint
+
 column_constraint : NOT_NULL conflict_clause(?)
     {
         $return = {
@@ -377,7 +387,24 @@ column_constraint : NOT_NULL conflict_clause(?)
         }
     }
 
-constraint_def : PRIMARY_KEY parens_field_list conflict_clause(?)
+constraint_def : comment(s?) CONSTRAINT constraint_name table_constraint
+    {
+        $return = {
+            comments => $item[1],
+            name => $item[3],
+            %{ $item[4] },
+        }
+    }
+    |
+    comment(s?) table_constraint
+    {
+        $return = {
+            comments => $item[1],
+            %{ $item[2] },
+        }
+    }
+
+table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?)
     {
         $return         = {
             supertype   => 'constraint',
@@ -420,6 +447,8 @@ qualified_name : /(\w+)\.(\w+)/
 
 field_name : NAME
 
+constraint_name : NAME
+
 conflict_clause : /on conflict/i conflict_algorigthm
 
 conflict_algorigthm : /(rollback|abort|fail|ignore|replace)/i
@@ -564,6 +593,8 @@ WHEN : /when/i
 
 REFERENCES : /references/i
 
+CONSTRAINT : /constraint/i
+
 AUTOINCREMENT : /autoincrement/i
 
 UNIQUE : /unique/i { 1 }

diff --git a/t/27sqlite-parser.t b/t/27sqlite-parser.t
index c221312..198d8c3 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(12,
+    maybe_plan(19,
         'SQL::Translator::Parser::SQLite');
 }
 SQL::Translator::Parser::SQLite->import('parse');
@@ -56,3 +56,31 @@ my $file = "$Bin/data/sqlite/create.sql";
     my @triggers = $schema->get_triggers;
     is( scalar @triggers, 1, 'Parsed one triggers' );
 }
+
+$file = "$Bin/data/sqlite/named.sql";
+{
+    local $/;
+    open my $fh, "<$file" or die "Can't read file '$file': $!\n";
+    my $data = <$fh>;
+    my $t = SQL::Translator->new;
+    parse($t, $data);
+
+    my $schema = $t->schema;
+
+    my @tables = $schema->get_tables;
+    is( scalar @tables, 1, 'Parsed one table' );
+
+    my $t1 = shift @tables;
+    is( $t1->name, 'pet', "'Pet' table" );
+
+    my @constraints = $t1->get_constraints;
+    is( scalar @constraints, 3, '3 constraints on pet' );
+
+    my $c1 = pop @constraints;
+    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( join(',', $c1->reference_fields), 'person_id', 
+        'References person_id field' );
+
+}