package SQL::Translator::Parser::SQLite;
-# -------------------------------------------------------------------
-# $Id: SQLite.pm,v 1.10 2006-06-09 13:56:58 schiffbruechige Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2002-4 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
=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
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 ]
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
=cut
use strict;
-use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
+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,
}
| drop
| comment
| create
- | <error>
+ | /^\Z/ | { _err ($thisline, $text) }
-begin_transaction : /begin transaction/i SEMICOLON
+begin_transaction : /begin/i TRANSACTION(?) SEMICOLON
commit : /commit/i SEMICOLON
-drop : /drop/i TABLE <commit> table_name SEMICOLON
+drop : /drop/i (tbl_drop | view_drop | trg_drop) SEMICOLON
+
+tbl_drop: TABLE <commit> table_name
+
+view_drop: VIEW if_exists(?) view_name
+
+trg_drop: TRIGGER if_exists(?) trigger_name
comment : /^\s*(?:#|-{2}).*\n/
{
$return = $comment;
}
-comment : /\/\*/ /[^\*]+/ /\*\//
+comment : /\/\*/ /[^\*]+/ /\*\//
{
my $comment = $item[2];
$comment =~ s/^\s*|\s*$//g;
#
# Create Index
#
-create : CREATE TEMPORARY(?) UNIQUE(?) INDEX WORD ON table_name parens_field_list conflict_clause(?) SEMICOLON
+create : CREATE TEMPORARY(?) UNIQUE(?) INDEX NAME ON table_name parens_field_list conflict_clause(?) SEMICOLON
{
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],
}
}
-definition : constraint_def | column_def
+definition : constraint_def | column_def
-column_def: NAME type(?) column_constraint(s?)
+column_def: comment(s?) NAME type(?) column_constraint_def(s?)
{
my $column = {
supertype => 'column',
- name => $item[1],
- data_type => $item[2][0]->{'type'},
- size => $item[2][0]->{'size'},
+ name => $item[2],
+ data_type => $item[3][0]->{'type'},
+ size => $item[3][0]->{'size'},
is_nullable => 1,
is_primary_key => 0,
is_unique => 0,
check => '',
default => undef,
- constraints => $item[3],
+ constraints => $item[4],
+ comments => $item[1],
};
- for my $c ( @{ $item[3] } ) {
+
+ for my $c ( @{ $item[4] } ) {
if ( $c->{'type'} eq 'not_null' ) {
$column->{'is_nullable'} = 0;
}
elsif ( $c->{'type'} eq 'default' ) {
$column->{'default'} = $c->{'value'};
}
+ elsif ( $c->{'type'} eq 'autoincrement' ) {
+ $column->{'is_auto_inc'} = 1;
+ }
}
$column;
}
}
+column_constraint_def : CONSTRAINT constraint_name column_constraint
+ {
+ $return = {
+ name => $item[2],
+ %{ $item[3] },
+ }
+ }
+ |
+ column_constraint
+
column_constraint : NOT_NULL conflict_clause(?)
{
$return = {
$return = {
type => 'primary_key',
sort_order => $item[2][0],
- on_conflict => $item[2][0],
+ on_conflict => $item[2][0],
}
}
|
{
$return = {
type => 'unique',
- on_conflict => $item[2][0],
+ on_conflict => $item[2][0],
}
}
|
$return = {
type => 'check',
expression => $item[3],
- on_conflict => $item[5][0],
+ on_conflict => $item[5][0],
}
}
|
value => $item[2],
}
}
+ |
+ 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'},
+ }
+ }
+ |
+ AUTOINCREMENT
+ {
+ $return = {
+ type => 'autoincrement',
+ }
+ }
-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',
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}
+
+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
+constraint_name : NAME
+
conflict_clause : /on conflict/i conflict_algorigthm
conflict_algorigthm : /(rollback|abort|fail|ignore|replace)/i
#
# Create Trigger
-create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action
+create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action SEMICOLON
{
my $table_name = $item[8]->{'name'};
push @triggers, {
is_temporary => $item[2][0] ? 1 : 0,
when => $item[5][0],
instead_of => 0,
- db_event => $item[6],
+ db_events => [ $item[6] ],
action => $item[9],
on_table => $table_name,
}
is_temporary => $item[2][0] ? 1 : 0,
when => undef,
instead_of => 1,
- db_event => $item[6],
+ db_events => [ $item[6] ],
action => $item[9],
on_table => $table_name,
}
}
}
-for_each : /FOR EACH ROW/i | /FOR EACH STATEMENT/i
+for_each : /FOR EACH ROW/i
when : WHEN expr { $item[2] }
string :
- /'(\\.|''|[^\\\'])*'/
+ /'(\.|''|[^\\'])*'/
nonstring : /[^;\'"]+/
-statement_body : (string | nonstring)(s?)
+statement_body : string | nonstring
-trigger_step : /(select|delete|insert|update)/i statement_body SEMICOLON
+trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON
{
- $return = join( ' ', $item[1], $item[2] )
- }
+ $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
+ }
before_or_after : /(before|after)/i { $return = lc $1 }
instead_of : /instead of/i
+if_exists : /if exists/i
+
view_name : qualified_name
+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,
}
}
END_C : /end/i
+TRANSACTION: /transaction/i
+
CREATE : /create/i
TEMPORARY : /temp(orary)?/i { 1 }
PRIMARY_KEY : /primary key/i
+FOREIGN_KEY : /foreign key/i
+
CHECK_C : /check/i
DEFAULT : /default/i
WHEN : /when/i
+REFERENCES : /references/i
+
+CONSTRAINT : /constraint/i
+
+AUTOINCREMENT : /autoincrement/i
+
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;
for my $idata ( @{ $tdata->{'indices'} || [] } ) {
my $index = $table->add_index(
name => $idata->{'name'},
- type => uc $idata->{'type'},
+ type => uc ($idata->{'type'}||''),
fields => $idata->{'fields'},
) or die $table->error;
}
reference_table => $cdata->{'reference_table'},
reference_fields => $cdata->{'reference_fields'},
match_type => $cdata->{'match_type'} || '',
- on_delete => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
- on_update => $cdata->{'on_update'} || $cdata->{'on_update_do'},
+ on_delete => $cdata->{'on_delete'}
+ || $cdata->{'on_delete_do'},
+ on_update => $cdata->{'on_update'}
+ || $cdata->{'on_update_do'},
) or die $table->error;
}
}
my $view = $schema->add_trigger(
name => $def->{'name'},
perform_action_when => $def->{'when'},
- database_event => $def->{'db_event'},
+ 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
# -------------------------------------------------------------------
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
projects / dbsrgits/SQL-Translator.git / blobdiff