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
=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 ? '...' : ()
+ );
+ }
+
}
#
| drop
| comment
| create
- | <error>
+ | /^\Z/ | { _err ($thisline, $text) }
begin_transaction : /begin/i TRANSACTION(?) SEMICOLON
}
}
|
- 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'},
}
}
|
}
}
|
- FOREIGN_KEY parens_field_list REFERENCES ref_def
+ FOREIGN_KEY parens_field_list REFERENCES ref_def cascade_def(?)
{
$return = {
supertype => 'constraint',
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
when : WHEN expr { $item[2] }
string :
- /'(\\.|''|[^\\\'])*'/
+ /'(\.|''|[^\\'])*'/
nonstring : /[^;\'"]+/
SEMICOLON : ';'
-NAME : /["']?(\w+)["']?/ { $return = $1 }
+NAME : /\w+/
+ | DQSTRING
+ | SQSTRING
+
+DQSTRING : '"' <skip: ''> /((?:[^"]|"")+)/ '"'
+ { ($return = $item[3]) =~ s/""/"/g }
+
+SQSTRING : "'" <skip: ''> /((?:[^']|'')*)/ "'"
+ { ($return = $item[3]) =~ s/''/'/g }
-VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
+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;
database_events => $def->{'db_events'},
action => $def->{'action'},
on_table => $def->{'on_table'},
+ scope => 'row', # SQLite only supports row triggers
);
}
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
# -------------------------------------------------------------------
projects / dbsrgits/SQL-Translator.git / blobdiff