1 package SQL::Translator::Parser::SQLite;
3 # -------------------------------------------------------------------
4 # Copyright (C) 2002-2009 SQLFairy Authors
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License as
8 # published by the Free Software Foundation; version 2.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19 # -------------------------------------------------------------------
23 SQL::Translator::Parser::SQLite - parser for SQLite
28 use SQL::Translator::Parser::SQLite;
30 my $translator = SQL::Translator->new;
31 $translator->parser("SQL::Translator::Parser::SQLite");
35 This is a grammar for parsing CREATE statements for SQLite as
38 http://www.sqlite.org/lang.html
43 CREATE [TEMP | TEMPORARY] [UNIQUE] INDEX index-name
44 ON [database-name .] table-name ( column-name [, column-name]* )
45 [ ON CONFLICT conflict-algorithm ]
53 CREATE [TEMP | TEMPORARY] TABLE table-name (
54 column-def [, column-def]*
59 CREATE [TEMP | TEMPORARY] TABLE table-name AS select-statement
62 name [type] [[CONSTRAINT name] column-constraint]*
67 typename ( number , number )
70 NOT NULL [ conflict-clause ] |
71 PRIMARY KEY [sort-order] [ conflict-clause ] |
72 UNIQUE [ conflict-clause ] |
73 CHECK ( expr ) [ conflict-clause ] |
77 PRIMARY KEY ( name [, name]* ) [ conflict-clause ]|
78 UNIQUE ( name [, name]* ) [ conflict-clause ] |
79 CHECK ( expr ) [ conflict-clause ]
82 ON CONFLICT conflict-algorithm
87 CREATE [TEMP | TEMPORARY] TRIGGER trigger-name [ BEFORE | AFTER ]
88 database-event ON [database-name .] table-name
92 CREATE [TEMP | TEMPORARY] TRIGGER trigger-name INSTEAD OF
93 database-event ON [database-name .] view-name
100 UPDATE OF column-list
103 [ FOR EACH ROW | FOR EACH STATEMENT ] [ WHEN expression ]
105 trigger-step ; [ trigger-step ; ]*
109 update-statement | insert-statement |
110 delete-statement | select-statement
115 CREATE [TEMP | TEMPORARY] VIEW view-name AS select-statement
120 ON CONFLICT conflict-algorithm
122 conflict-algorithm ::=
123 ROLLBACK | ABORT | FAIL | IGNORE | REPLACE
128 expr binary-op expr |
133 table-name . column-name |
134 database-name . table-name . column-name |
136 function-name ( expr-list | * ) |
140 expr [NOT] BETWEEN expr AND expr |
141 expr [NOT] IN ( value-list ) |
142 expr [NOT] IN ( select-statement ) |
143 ( select-statement ) |
144 CASE [expr] ( WHEN expr THEN expr )+ [ELSE expr] END
147 LIKE | GLOB | NOT LIKE | NOT GLOB
152 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
154 $DEBUG = 0 unless defined $DEBUG;
157 use Parse::RecDescent;
159 use base qw(Exporter);
161 @EXPORT_OK = qw(parse);
163 # Enable warnings within the Parse::RecDescent module.
164 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
165 $::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.
166 $::RD_HINT = 1; # Give out hints to help fix problems.
171 my ( %tables, $table_order, @table_comments, @views, @triggers );
175 # The "eofile" rule makes the parser fail if any "statement" rule
176 # fails. Otherwise, the first successful match by a "statement"
177 # won't cause the failure needed to know that the parse, as a whole,
180 startrule : statement(s) eofile {
184 triggers => \@triggers,
190 statement : begin_transaction
197 begin_transaction : /begin/i TRANSACTION(?) SEMICOLON
199 commit : /commit/i SEMICOLON
201 drop : /drop/i (tbl_drop | view_drop | trg_drop) SEMICOLON
203 tbl_drop: TABLE <commit> table_name
205 view_drop: VIEW if_exists(?) view_name
207 trg_drop: TRIGGER if_exists(?) trigger_name
209 comment : /^\s*(?:#|-{2}).*\n/
211 my $comment = $item[1];
212 $comment =~ s/^\s*(#|-{2})\s*//;
213 $comment =~ s/\s*$//;
217 comment : /\/\*/ /[^\*]+/ /\*\//
219 my $comment = $item[2];
220 $comment =~ s/^\s*|\s*$//g;
227 create : CREATE TEMPORARY(?) UNIQUE(?) INDEX NAME ON table_name parens_field_list conflict_clause(?) SEMICOLON
229 my $db_name = $item[7]->{'db_name'} || '';
230 my $table_name = $item[7]->{'name'};
235 on_conflict => $item[9][0],
236 is_temporary => $item[2][0] ? 1 : 0,
239 my $is_unique = $item[3][0];
242 $index->{'type'} = 'unique';
243 push @{ $tables{ $table_name }{'constraints'} }, $index;
246 push @{ $tables{ $table_name }{'indices'} }, $index;
253 create : CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLON
255 my $db_name = $item[4]->{'db_name'} || '';
256 my $table_name = $item[4]->{'name'};
258 $tables{ $table_name }{'name'} = $table_name;
259 $tables{ $table_name }{'is_temporary'} = $item[2][0] ? 1 : 0;
260 $tables{ $table_name }{'order'} = ++$table_order;
262 for my $def ( @{ $item[6] } ) {
263 if ( $def->{'supertype'} eq 'column' ) {
264 push @{ $tables{ $table_name }{'fields'} }, $def;
266 elsif ( $def->{'supertype'} eq 'constraint' ) {
267 push @{ $tables{ $table_name }{'constraints'} }, $def;
272 definition : constraint_def | column_def
274 column_def: comment(s?) NAME type(?) column_constraint(s?)
277 supertype => 'column',
279 data_type => $item[3][0]->{'type'},
280 size => $item[3][0]->{'size'},
286 constraints => $item[4],
287 comments => $item[1],
291 for my $c ( @{ $item[4] } ) {
292 if ( $c->{'type'} eq 'not_null' ) {
293 $column->{'is_nullable'} = 0;
295 elsif ( $c->{'type'} eq 'primary_key' ) {
296 $column->{'is_primary_key'} = 1;
298 elsif ( $c->{'type'} eq 'unique' ) {
299 $column->{'is_unique'} = 1;
301 elsif ( $c->{'type'} eq 'check' ) {
302 $column->{'check'} = $c->{'expression'};
304 elsif ( $c->{'type'} eq 'default' ) {
305 $column->{'default'} = $c->{'value'};
307 elsif ( $c->{'type'} eq 'autoincrement' ) {
308 $column->{'is_auto_inc'} = 1;
315 type : WORD parens_value_list(?)
323 column_constraint : NOT_NULL conflict_clause(?)
330 PRIMARY_KEY sort_order(?) conflict_clause(?)
333 type => 'primary_key',
334 sort_order => $item[2][0],
335 on_conflict => $item[2][0],
339 UNIQUE conflict_clause(?)
343 on_conflict => $item[2][0],
347 CHECK_C '(' expr ')' conflict_clause(?)
351 expression => $item[3],
352 on_conflict => $item[5][0],
367 type => 'foreign_key',
368 reference_table => $item[2]{'reference_table'},
369 reference_fields => $item[2]{'reference_fields'},
376 type => 'autoincrement',
380 constraint_def : PRIMARY_KEY parens_field_list conflict_clause(?)
383 supertype => 'constraint',
384 type => 'primary_key',
386 on_conflict => $item[3][0],
390 UNIQUE parens_field_list conflict_clause(?)
393 supertype => 'constraint',
396 on_conflict => $item[3][0],
400 CHECK_C '(' expr ')' conflict_clause(?)
403 supertype => 'constraint',
405 expression => $item[3],
406 on_conflict => $item[5][0],
410 ref_def : /(\w+)\s*\((\w+)\)/
411 { $return = { reference_table => $1, reference_fields => $2 } }
413 table_name : qualified_name
415 qualified_name : NAME
416 { $return = { name => $item[1] } }
418 qualified_name : /(\w+)\.(\w+)/
419 { $return = { db_name => $1, name => $2 } }
423 conflict_clause : /on conflict/i conflict_algorigthm
425 conflict_algorigthm : /(rollback|abort|fail|ignore|replace)/i
427 parens_field_list : '(' column_list ')'
430 column_list : field_name(s /,/)
432 parens_value_list : '(' VALUE(s /,/) ')'
437 sort_order : /(ASC|DESC)/i
442 create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action SEMICOLON
444 my $table_name = $item[8]->{'name'};
447 is_temporary => $item[2][0] ? 1 : 0,
450 db_events => [ $item[6] ],
452 on_table => $table_name,
456 create : CREATE TEMPORARY(?) TRIGGER NAME instead_of database_event ON view_name trigger_action
458 my $table_name = $item[8]->{'name'};
461 is_temporary => $item[2][0] ? 1 : 0,
464 db_events => [ $item[6] ],
466 on_table => $table_name,
470 database_event : /(delete|insert|update)/i
472 database_event : /update of/i column_list
474 trigger_action : for_each(?) when(?) BEGIN_C trigger_step(s) END_C
477 for_each => $item[1][0],
483 for_each : /FOR EACH ROW/i
485 when : WHEN expr { $item[2] }
488 /'(\\.|''|[^\\\'])*'/
490 nonstring : /[^;\'"]+/
492 statement_body : string | nonstring
494 trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON
496 $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
499 before_or_after : /(before|after)/i { $return = lc $1 }
501 instead_of : /instead of/i
503 if_exists : /if exists/i
505 view_name : qualified_name
507 trigger_name : qualified_name
512 create : CREATE TEMPORARY(?) VIEW view_name AS select_statement
515 name => $item[4]->{'name'},
517 is_temporary => $item[2][0] ? 1 : 0,
521 select_statement : SELECT /[^;]+/ SEMICOLON
523 $return = join( ' ', $item[1], $item[2] );
533 TRANSACTION: /transaction/i
537 TEMPORARY : /temp(orary)?/i { 1 }
543 NOT_NULL : /not null/i
545 PRIMARY_KEY : /primary key/i
565 REFERENCES : /references/i
567 AUTOINCREMENT : /autoincrement/i
569 UNIQUE : /unique/i { 1 }
573 NAME : /["']?(\w+)["']?/ { $return = $1 }
575 VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
579 # remove leading/trailing quotes
581 $val =~ s/^['"]|['"]$//g;
586 | /CURRENT_TIMESTAMP/i
587 { 'CURRENT_TIMESTAMP' }
591 # -------------------------------------------------------------------
593 my ( $translator, $data ) = @_;
594 my $parser = Parse::RecDescent->new($GRAMMAR);
596 local $::RD_TRACE = $translator->trace ? 1 : undef;
597 local $DEBUG = $translator->debug;
599 unless (defined $parser) {
600 return $translator->error("Error instantiating Parse::RecDescent ".
601 "instance: Bad grammer");
604 my $result = $parser->startrule($data);
605 return $translator->error( "Parse failed." ) unless defined $result;
606 warn Dumper( $result ) if $DEBUG;
608 my $schema = $translator->schema;
611 sort { $a->[0] <=> $b->[0] }
612 map { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] }
613 keys %{ $result->{'tables'} };
615 for my $table_name ( @tables ) {
616 my $tdata = $result->{'tables'}{ $table_name };
617 my $table = $schema->add_table(
618 name => $tdata->{'name'},
619 ) or die $schema->error;
621 $table->comments( $tdata->{'comments'} );
623 for my $fdata ( @{ $tdata->{'fields'} } ) {
624 my $field = $table->add_field(
625 name => $fdata->{'name'},
626 data_type => $fdata->{'data_type'},
627 size => $fdata->{'size'},
628 default_value => $fdata->{'default'},
629 is_auto_increment => $fdata->{'is_auto_inc'},
630 is_nullable => $fdata->{'is_nullable'},
631 comments => $fdata->{'comments'},
632 ) or die $table->error;
634 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
636 for my $cdata ( @{ $fdata->{'constraints'} } ) {
637 next unless $cdata->{'type'} eq 'foreign_key';
638 $cdata->{'fields'} ||= [ $field->name ];
639 push @{ $tdata->{'constraints'} }, $cdata;
643 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
644 my $index = $table->add_index(
645 name => $idata->{'name'},
646 type => uc $idata->{'type'},
647 fields => $idata->{'fields'},
648 ) or die $table->error;
651 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
652 my $constraint = $table->add_constraint(
653 name => $cdata->{'name'},
654 type => $cdata->{'type'},
655 fields => $cdata->{'fields'},
656 reference_table => $cdata->{'reference_table'},
657 reference_fields => $cdata->{'reference_fields'},
658 match_type => $cdata->{'match_type'} || '',
659 on_delete => $cdata->{'on_delete'}
660 || $cdata->{'on_delete_do'},
661 on_update => $cdata->{'on_update'}
662 || $cdata->{'on_update_do'},
663 ) or die $table->error;
667 for my $def ( @{ $result->{'views'} || [] } ) {
668 my $view = $schema->add_view(
669 name => $def->{'name'},
670 sql => $def->{'sql'},
674 for my $def ( @{ $result->{'triggers'} || [] } ) {
675 my $view = $schema->add_trigger(
676 name => $def->{'name'},
677 perform_action_when => $def->{'when'},
678 database_events => $def->{'db_events'},
679 action => $def->{'action'},
680 on_table => $def->{'on_table'},
689 # -------------------------------------------------------------------
690 # All wholsome food is caught without a net or a trap.
692 # -------------------------------------------------------------------
698 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
702 perl(1), Parse::RecDescent, SQL::Translator::Schema.