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=e0e3cca3da62f4b35d7a02ab522f71697e27e614;hpb=282bf498899061be19ec7fd7ce16bf25a562fdcf;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index e0e3cca..4787302 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/lib/SQL/Translator/Parser/SQLite.pm @@ -1,23 +1,5 @@ package SQL::Translator::Parser::SQLite; -# ------------------------------------------------------------------- -# Copyright (C) 2002-2009 SQLFairy Authors -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as -# published by the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -# 02111-1307 USA -# ------------------------------------------------------------------- - =head1 NAME SQL::Translator::Parser::SQLite - parser for SQLite @@ -149,26 +131,33 @@ 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 base qw(Exporter); - -@EXPORT_OK = qw(parse); +use SQL::Translator::Utils qw/ddl_parser_instance/; -# 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 ); + + 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 ? '...' : () + ); + } + } # @@ -192,7 +181,7 @@ statement : begin_transaction | drop | comment | create - | + | /^\Z/ | { _err ($thisline, $text) } begin_transaction : /begin/i TRANSACTION(?) SEMICOLON @@ -371,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'}, } } | @@ -434,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', @@ -442,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 @@ -525,7 +530,7 @@ for_each : /FOR EACH ROW/i when : WHEN expr { $item[2] } string : - /'(\\.|''|[^\\\'])*'/ + /'(\.|''|[^\\'])*'/ nonstring : /[^;\'"]+/ @@ -614,35 +619,39 @@ UNIQUE : /unique/i { 1 } SEMICOLON : ';' -NAME : /["']?(\w+)["']?/ { $return = $1 } +NAME : /\w+/ + | DQSTRING + | SQSTRING + +DQSTRING : '"' /((?:[^"]|"")+)/ '"' + { ($return = $item[3]) =~ s/""/"/g } -VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/ +SQSTRING : "'" /((?:[^']|'')*)/ "'" + { ($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; @@ -730,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 # -------------------------------------------------------------------