X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FSQLite.pm;h=459f20384c75bffda6b2efb394af86d503892dca;hb=565563b9799775b9992c3f7cb85753b1d2b31c39;hp=169b5162a0356d0c7ab910642a3253348522c7b4;hpb=95044c79c230e816a4c1c3cd5f9b2b4114d3ef0f;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index 169b516..459f203 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/lib/SQL/Translator/Parser/SQLite.pm @@ -132,23 +132,19 @@ like-op::= use strict; use warnings; -our ( $DEBUG, $GRAMMAR, @EXPORT_OK ); + our $VERSION = '1.59'; + +our $DEBUG; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; -use Parse::RecDescent; -use Exporter; -use base qw(Exporter); +use SQL::Translator::Utils qw/ddl_parser_instance/; -@EXPORT_OK = qw(parse); - -# 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. +use base qw(Exporter); +our @EXPORT_OK = qw(parse); -$GRAMMAR = q! +our $GRAMMAR = <<'END_OF_GRAMMAR'; { my ( %tables, $table_order, @table_comments, @views, @triggers ); @@ -364,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'}, } } | @@ -427,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', @@ -435,11 +433,25 @@ 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 : /(\w+)\s*\((\w+)\)/ - { $return = { reference_table => $1, reference_fields => $2 } } +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} + +cascade_update_def : /on\s+update\s+(set null|set default|cascade|restrict|no action)/i + { $return = $1} table_name : qualified_name @@ -518,7 +530,7 @@ for_each : /FOR EACH ROW/i when : WHEN expr { $item[2] } string : - /'(\\.|''|[^\\\'])*'/ + /'(\.|''|[^\\'])*'/ nonstring : /[^;\'"]+/ @@ -623,19 +635,21 @@ VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/ | /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;