X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FSQLite.pm;h=4787302678f656928b435f226c58ca838d6ea3a0;hb=fd498bb0acde8fb312f841aaebc896ed19db59d1;hp=65bf404f145c1dd88655f36cb714985d871cc956;hpb=935800450f88b0500c4fa7c3b174cd22b5f9eb56;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm
index 65bf404..4787302 100644
--- a/lib/SQL/Translator/Parser/SQLite.pm
+++ b/lib/SQL/Translator/Parser/SQLite.pm
@@ -14,7 +14,7 @@ SQL::Translator::Parser::SQLite - parser for SQLite
 
 =head1 DESCRIPTION
 
-This is a grammar for parsing CREATE statements for SQLite as 
+This is a grammar for parsing CREATE statements for SQLite as
 described here:
 
     http://www.sqlite.org/lang.html
@@ -22,7 +22,7 @@ described here:
 CREATE INDEX
 
 sql-statement ::=
-    CREATE [TEMP | TEMPORARY] [UNIQUE] INDEX index-name 
+    CREATE [TEMP | TEMPORARY] [UNIQUE] INDEX index-name
      ON [database-name .] table-name ( column-name [, column-name]* )
      [ ON CONFLICT conflict-algorithm ]
 
@@ -76,19 +76,19 @@ sql-statement ::=
     trigger-action
 
 database-event ::=
-    DELETE | 
-    INSERT | 
-    UPDATE | 
+    DELETE |
+    INSERT |
+    UPDATE |
     UPDATE OF column-list
 
 trigger-action ::=
-    [ FOR EACH ROW | FOR EACH STATEMENT ] [ WHEN expression ] 
-        BEGIN 
+    [ FOR EACH ROW | FOR EACH STATEMENT ] [ WHEN expression ]
+        BEGIN
             trigger-step ; [ trigger-step ; ]*
         END
 
 trigger-step ::=
-    update-statement | insert-statement | 
+    update-statement | insert-statement |
     delete-statement | select-statement
 
 CREATE VIEW
@@ -131,37 +131,44 @@ like-op::=
 =cut
 
 use strict;
-use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+use warnings;
+
+our $VERSION = '1.59';
+
+our $DEBUG;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
-use Parse::RecDescent;
-use Exporter;
+use SQL::Translator::Utils qw/ddl_parser_instance/;
+
 use base qw(Exporter);
+our @EXPORT_OK = qw(parse);
 
-@EXPORT_OK = qw(parse);
+our $GRAMMAR = <<'END_OF_GRAMMAR';
 
-# Enable warnings within the Parse::RecDescent module.
-$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
-$::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
-$::RD_HINT   = 1; # Give out hints to help fix problems.
+{
+    my ( %tables, $table_order, @table_comments, @views, @triggers );
 
-$GRAMMAR = q!
+    sub _err {
+      my $max_lines = 5;
+      my @up_to_N_lines = split (/\n/, $_[1], $max_lines + 1);
+      die sprintf ("Unable to parse line %d:\n%s\n",
+        $_[0],
+        join "\n", (map { "'$_'" } @up_to_N_lines[0..$max_lines - 1 ]), @up_to_N_lines > $max_lines ? '...' : ()
+      );
+    }
 
-{ 
-    my ( %tables, $table_order, @table_comments, @views, @triggers );
 }
 
 #
 # The "eofile" rule makes the parser fail if any "statement" rule
-# fails.  Otherwise, the first successful match by a "statement" 
+# fails.  Otherwise, the first successful match by a "statement"
 # won't cause the failure needed to know that the parse, as a whole,
 # failed. -ky
 #
-startrule : statement(s) eofile { 
+startrule : statement(s) eofile {
     $return      = {
-        tables   => \%tables, 
+        tables   => \%tables,
         views    => \@views,
         triggers => \@triggers,
     }
@@ -174,7 +181,7 @@ statement : begin_transaction
     | drop
     | comment
     | create
-    | <error>
+    | /^\Z/ | { _err ($thisline, $text) }
 
 begin_transaction : /begin/i TRANSACTION(?) SEMICOLON
 
@@ -196,7 +203,7 @@ comment : /^\s*(?:#|-{2}).*\n/
         $return     = $comment;
     }
 
-comment : /\/\*/ /[^\*]+/ /\*\// 
+comment : /\/\*/ /[^\*]+/ /\*\//
     {
         my $comment = $item[2];
         $comment    =~ s/^\s*|\s*$//g;
@@ -211,7 +218,7 @@ create : CREATE TEMPORARY(?) UNIQUE(?) INDEX NAME ON table_name parens_field_lis
         my $db_name    = $item[7]->{'db_name'} || '';
         my $table_name = $item[7]->{'name'};
 
-        my $index        =  { 
+        my $index        =  {
             name         => $item[5],
             fields       => $item[8],
             on_conflict  => $item[9][0],
@@ -251,7 +258,7 @@ create : CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLO
         }
     }
 
-definition : constraint_def | column_def 
+definition : constraint_def | column_def
 
 column_def: comment(s?) NAME type(?) column_constraint_def(s?)
     {
@@ -324,7 +331,7 @@ column_constraint : NOT_NULL conflict_clause(?)
         $return = {
             type        => 'primary_key',
             sort_order  => $item[2][0],
-            on_conflict => $item[2][0], 
+            on_conflict => $item[2][0],
         }
     }
     |
@@ -332,7 +339,7 @@ column_constraint : NOT_NULL conflict_clause(?)
     {
         $return = {
             type        => 'unique',
-            on_conflict => $item[2][0], 
+            on_conflict => $item[2][0],
         }
     }
     |
@@ -341,7 +348,7 @@ column_constraint : NOT_NULL conflict_clause(?)
         $return = {
             type        => 'check',
             expression  => $item[3],
-            on_conflict => $item[5][0], 
+            on_conflict => $item[5][0],
         }
     }
     |
@@ -353,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'},
         }
     }
     |
@@ -415,16 +424,41 @@ table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?)
             on_conflict => $item[5][0],
         }
     }
+    |
+    FOREIGN_KEY parens_field_list REFERENCES ref_def cascade_def(?)
+    {
+      $return = {
+        supertype        => 'constraint',
+        type             => 'foreign_key',
+        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+(set null|set default|cascade|restrict|no action)/i
+    { $return = $1}
 
-ref_def : /(\w+)\s*\((\w+)\)/
-    { $return = { reference_table => $1, reference_fields => $2 } }
+cascade_update_def : /on\s+update\s+(set null|set default|cascade|restrict|no action)/i
+    { $return = $1}
 
 table_name : qualified_name
-    
-qualified_name : NAME 
+
+qualified_name : NAME
     { $return = { name => $item[1] } }
 
-qualified_name : /(\w+)\.(\w+)/ 
+qualified_name : /(\w+)\.(\w+)/
     { $return = { db_name => $1, name => $2 } }
 
 field_name : NAME
@@ -496,7 +530,7 @@ for_each : /FOR EACH ROW/i
 when : WHEN expr { $item[2] }
 
 string :
-   /'(\\.|''|[^\\\'])*'/ 
+   /'(\.|''|[^\\'])*'/
 
 nonstring : /[^;\'"]+/
 
@@ -505,7 +539,7 @@ statement_body : string | nonstring
 trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON
     {
         $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
-    }   
+    }
 
 before_or_after : /(before|after)/i { $return = lc $1 }
 
@@ -520,11 +554,11 @@ trigger_name : qualified_name
 #
 # Create View
 #
-create : CREATE TEMPORARY(?) VIEW view_name AS select_statement 
+create : CREATE TEMPORARY(?) VIEW view_name AS select_statement
     {
         push @views, {
             name         => $item[4]->{'name'},
-            sql          => $item[6], 
+            sql          => $item[6],
             is_temporary => $item[2][0] ? 1 : 0,
         }
     }
@@ -555,6 +589,8 @@ NOT_NULL : /not null/i
 
 PRIMARY_KEY : /primary key/i
 
+FOREIGN_KEY : /foreign key/i
+
 CHECK_C : /check/i
 
 DEFAULT : /default/i
@@ -583,51 +619,54 @@ UNIQUE : /unique/i { 1 }
 
 SEMICOLON : ';'
 
-NAME : /["']?(\w+)["']?/ { $return = $1 }
+NAME : /\w+/
+    | DQSTRING
+    | SQSTRING
+
+DQSTRING : '"' <skip: ''> /((?:[^"]|"")+)/ '"'
+    { ($return = $item[3]) =~ s/""/"/g }
 
-VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
+SQSTRING : "'" <skip: ''> /((?:[^']|'')*)/ "'"
+    { ($return = $item[3]) =~ s/''/'/g }
+
+VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/
     { $item[1] }
-    | /'.*?'/   
-    { 
-        # remove leading/trailing quotes 
-        my $val = $item[1];
-        $val    =~ s/^['"]|['"]$//g;
-        $return = $val;
-    }
-    | /NULL/
+    | SQSTRING
+    | /NULL/i
     { 'NULL' }
     | /CURRENT_TIMESTAMP/i
     { 'CURRENT_TIMESTAMP' }
 
-!;
+END_OF_GRAMMAR
+
 
-# -------------------------------------------------------------------
 sub parse {
     my ( $translator, $data ) = @_;
-    my $parser = Parse::RecDescent->new($GRAMMAR);
+
+    # Enable warnings within the Parse::RecDescent module.
+    local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
+    local $::RD_WARN   = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
+    local $::RD_HINT   = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.
 
     local $::RD_TRACE  = $translator->trace ? 1 : undef;
     local $DEBUG       = $translator->debug;
 
-    unless (defined $parser) {
-        return $translator->error("Error instantiating Parse::RecDescent ".
-            "instance: Bad grammer");
-    }
+    my $parser = ddl_parser_instance('SQLite');
 
     my $result = $parser->startrule($data);
     return $translator->error( "Parse failed." ) unless defined $result;
     warn Dumper( $result ) if $DEBUG;
 
     my $schema = $translator->schema;
-    my @tables = 
+    my @tables =
         map   { $_->[1] }
-        sort  { $a->[0] <=> $b->[0] } 
+        sort  { $a->[0] <=> $b->[0] }
         map   { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] }
         keys %{ $result->{'tables'} };
 
     for my $table_name ( @tables ) {
         my $tdata =  $result->{'tables'}{ $table_name };
-        my $table =  $schema->add_table( 
+        my $table =  $schema->add_table(
             name  => $tdata->{'name'},
         ) or die $schema->error;
 
@@ -669,9 +708,9 @@ sub parse {
                 reference_table  => $cdata->{'reference_table'},
                 reference_fields => $cdata->{'reference_fields'},
                 match_type       => $cdata->{'match_type'} || '',
-                on_delete        => $cdata->{'on_delete'} 
+                on_delete        => $cdata->{'on_delete'}
                                  || $cdata->{'on_delete_do'},
-                on_update        => $cdata->{'on_update'} 
+                on_update        => $cdata->{'on_update'}
                                  || $cdata->{'on_update_do'},
             ) or die $table->error;
         }
@@ -700,7 +739,7 @@ sub parse {
 1;
 
 # -------------------------------------------------------------------
-# All wholsome food is caught without a net or a trap.
+# All wholesome food is caught without a net or a trap.
 # William Blake
 # -------------------------------------------------------------------