X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FSQL-Translator.git;a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FSQLite.pm;h=251c97b1cc6334e6916ade5808721dc426862e83;hp=b5a7fc10f7ba9bc301c7adadc76e0c1710cfa8f4;hb=c0ec0e22d3f0e3852c00daac5ef5763010b410c3;hpb=72aa2647992f995d440313e4000855c538d57f51 diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index b5a7fc1..251c97b 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/lib/SQL/Translator/Parser/SQLite.pm @@ -1,27 +1,5 @@ package SQL::Translator::Parser::SQLite; -# ------------------------------------------------------------------- -# $Id: SQLite.pm,v 1.1 2003-10-03 00:20:51 kycl4rk Exp $ -# ------------------------------------------------------------------- -# Copyright (C) 2003 Ken Y. Clark , -# darren chamberlain , -# Chris Mungall -# -# 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 @@ -36,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 @@ -44,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 ] @@ -98,20 +76,20 @@ 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 | - delete-statement | select-statemen + update-statement | insert-statement | + delete-statement | select-statement CREATE VIEW @@ -153,48 +131,70 @@ like-op::= =cut use strict; -use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\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 ); } # # 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 { \%tables } +startrule : statement(s) eofile { + $return = { + tables => \%tables, + views => \@views, + triggers => \@triggers, + } +} eofile : /^\Z/ statement : begin_transaction | commit + | drop | comment | create - | + | /^\Z/ | { _err ($thisline, $text) } -begin_transaction : /begin transaction/i SEMICOLON +begin_transaction : /begin/i TRANSACTION(?) SEMICOLON commit : /commit/i SEMICOLON +drop : /drop/i (tbl_drop | view_drop | trg_drop) SEMICOLON + +tbl_drop: TABLE table_name + +view_drop: VIEW if_exists(?) view_name + +trg_drop: TRIGGER if_exists(?) trigger_name + comment : /^\s*(?:#|-{2}).*\n/ { my $comment = $item[1]; @@ -203,7 +203,7 @@ comment : /^\s*(?:#|-{2}).*\n/ $return = $comment; } -comment : /\/\*/ /[^\*]+/ /\*\// +comment : /\/\*/ /[^\*]+/ /\*\// { my $comment = $item[2]; $comment =~ s/^\s*|\s*$//g; @@ -213,12 +213,12 @@ comment : /\/\*/ /[^\*]+/ /\*\// # # 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], @@ -258,24 +258,26 @@ create : CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLO } } -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; } @@ -291,6 +293,9 @@ column_def: NAME type(?) column_constraint(s?) elsif ( $c->{'type'} eq 'default' ) { $column->{'default'} = $c->{'value'}; } + elsif ( $c->{'type'} eq 'autoincrement' ) { + $column->{'is_auto_inc'} = 1; + } } $column; @@ -304,6 +309,16 @@ type : WORD parens_value_list(?) } } +column_constraint_def : CONSTRAINT constraint_name column_constraint + { + $return = { + name => $item[2], + %{ $item[3] }, + } + } + | + column_constraint + column_constraint : NOT_NULL conflict_clause(?) { $return = { @@ -316,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], } } | @@ -324,7 +339,7 @@ column_constraint : NOT_NULL conflict_clause(?) { $return = { type => 'unique', - on_conflict => $item[2][0], + on_conflict => $item[2][0], } } | @@ -333,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], } } | @@ -344,8 +359,43 @@ column_constraint : NOT_NULL conflict_clause(?) 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 : 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] }, + } + } -constraint_def : PRIMARY_KEY parens_field_list conflict_clause(?) +table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?) { $return = { supertype => 'constraint', @@ -374,17 +424,47 @@ constraint_def : 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} + +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 @@ -404,29 +484,31 @@ sort_order : /(ASC|DESC)/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 @{ $tables{ $table_name }{'triggers'} }, { + push @triggers, { name => $item[4], 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, } } create : CREATE TEMPORARY(?) TRIGGER NAME instead_of database_event ON view_name trigger_action { my $table_name = $item[8]->{'name'}; - push @{ $tables{ $table_name }{'triggers'} }, { + push @triggers, { name => $item[4], 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, } } @@ -443,21 +525,49 @@ trigger_action : for_each(?) when(?) BEGIN_C trigger_step(s) END_C } } -for_each : /FOR EACH ROW/i | /FOR EACH STATEMENT/i +for_each : /FOR EACH ROW/i when : WHEN expr { $item[2] } -trigger_step : /(select|delete|insert|update)/i /[^;]+/ SEMICOLON +string : + /'(\.|''|[^\\'])*'/ + +nonstring : /[^;\'"]+/ + +statement_body : string | nonstring + +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 + { + push @views, { + name => $item[4]->{'name'}, + sql => $item[6], + is_temporary => $item[2][0] ? 1 : 0, + } + } + +select_statement : SELECT /[^;]+/ SEMICOLON + { + $return = join( ' ', $item[1], $item[2] ); + } + # # Tokens # @@ -465,6 +575,8 @@ BEGIN_C : /begin/i END_C : /end/i +TRANSACTION: /transaction/i + CREATE : /create/i TEMPORARY : /temp(orary)?/i { 1 } @@ -477,63 +589,84 @@ NOT_NULL : /not null/i PRIMARY_KEY : /primary key/i +FOREIGN_KEY : /foreign key/i + CHECK_C : /check/i DEFAULT : /default/i TRIGGER : /trigger/i +VIEW : /view/i + +SELECT : /select/i + ON : /on/i +AS : /as/i + WORD : /\w+/ 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 -VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/ +DQSTRING : '"' /((?:[^"]|"")+)/ '"' + { ($return = $item[3]) =~ s/""/"/g } + +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; warn Dumper( $result ) if $DEBUG; my $schema = $translator->schema; - my @tables = sort { - $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'} - } keys %{ $result }; + my @tables = + map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] } + keys %{ $result->{'tables'} }; for my $table_name ( @tables ) { - my $tdata = $result->{ $table_name }; - my $table = $schema->add_table( + my $tdata = $result->{'tables'}{ $table_name }; + my $table = $schema->add_table( name => $tdata->{'name'}, ) or die $schema->error; @@ -562,7 +695,7 @@ sub parse { 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; } @@ -575,19 +708,39 @@ sub parse { reference_table => $cdata->{'reference_table'}, reference_fields => $cdata->{'reference_fields'}, match_type => $cdata->{'match_type'} || '', - on_delete => $cdata->{'on_delete_do'}, - 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; } } + for my $def ( @{ $result->{'views'} || [] } ) { + my $view = $schema->add_view( + name => $def->{'name'}, + sql => $def->{'sql'}, + ); + } + + for my $def ( @{ $result->{'triggers'} || [] } ) { + my $view = $schema->add_trigger( + name => $def->{'name'}, + perform_action_when => $def->{'when'}, + database_events => $def->{'db_events'}, + action => $def->{'action'}, + on_table => $def->{'on_table'}, + scope => 'row', # SQLite only supports row triggers + ); + } + return 1; } 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 # ------------------------------------------------------------------- @@ -595,7 +748,7 @@ sub parse { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =head1 SEE ALSO