File Coverage

blib/lib/SQL/Translator/Parser/SQLite.pm
Criterion Covered Total %
statement 58 58 100.0
branch 22 32 68.7
condition 7 12 58.3
subroutine 6 6 100.0
pod 0 1 0.0
total 93 109 85.3


line stmt bran cond sub pod time code
1             package SQL::Translator::Parser::SQLite;
2              
3             =head1 NAME
4              
5             SQL::Translator::Parser::SQLite - parser for SQLite
6              
7             =head1 SYNOPSIS
8              
9             use SQL::Translator;
10             use SQL::Translator::Parser::SQLite;
11              
12             my $translator = SQL::Translator->new;
13             $translator->parser("SQL::Translator::Parser::SQLite");
14              
15             =head1 DESCRIPTION
16              
17             This is a grammar for parsing CREATE statements for SQLite as
18             described here:
19              
20             http://www.sqlite.org/lang.html
21              
22             CREATE INDEX
23              
24             sql-statement ::=
25             CREATE [TEMP | TEMPORARY] [UNIQUE] INDEX index-name
26             ON [database-name .] table-name ( column-name [, column-name]* )
27             [ ON CONFLICT conflict-algorithm ]
28              
29             column-name ::=
30             name [ ASC | DESC ]
31              
32             CREATE TABLE
33              
34             sql-command ::=
35             CREATE [TEMP | TEMPORARY] TABLE table-name (
36             column-def [, column-def]*
37             [, constraint]*
38             )
39              
40             sql-command ::=
41             CREATE [TEMP | TEMPORARY] TABLE table-name AS select-statement
42              
43             column-def ::=
44             name [type] [[CONSTRAINT name] column-constraint]*
45              
46             type ::=
47             typename |
48             typename ( number ) |
49             typename ( number , number )
50              
51             column-constraint ::=
52             NOT NULL [ conflict-clause ] |
53             PRIMARY KEY [sort-order] [ conflict-clause ] |
54             UNIQUE [ conflict-clause ] |
55             CHECK ( expr ) [ conflict-clause ] |
56             DEFAULT value
57              
58             constraint ::=
59             PRIMARY KEY ( name [, name]* ) [ conflict-clause ]|
60             UNIQUE ( name [, name]* ) [ conflict-clause ] |
61             CHECK ( expr ) [ conflict-clause ]
62              
63             conflict-clause ::=
64             ON CONFLICT conflict-algorithm
65              
66             CREATE TRIGGER
67              
68             sql-statement ::=
69             CREATE [TEMP | TEMPORARY] TRIGGER trigger-name [ BEFORE | AFTER ]
70             database-event ON [database-name .] table-name
71             trigger-action
72              
73             sql-statement ::=
74             CREATE [TEMP | TEMPORARY] TRIGGER trigger-name INSTEAD OF
75             database-event ON [database-name .] view-name
76             trigger-action
77              
78             database-event ::=
79             DELETE |
80             INSERT |
81             UPDATE |
82             UPDATE OF column-list
83              
84             trigger-action ::=
85             [ FOR EACH ROW | FOR EACH STATEMENT ] [ WHEN expression ]
86             BEGIN
87             trigger-step ; [ trigger-step ; ]*
88             END
89              
90             trigger-step ::=
91             update-statement | insert-statement |
92             delete-statement | select-statement
93              
94             CREATE VIEW
95              
96             sql-command ::=
97             CREATE [TEMP | TEMPORARY] VIEW view-name AS select-statement
98              
99             ON CONFLICT clause
100              
101             conflict-clause ::=
102             ON CONFLICT conflict-algorithm
103              
104             conflict-algorithm ::=
105             ROLLBACK | ABORT | FAIL | IGNORE | REPLACE
106              
107             expression
108              
109             expr ::=
110             expr binary-op expr |
111             expr like-op expr |
112             unary-op expr |
113             ( expr ) |
114             column-name |
115             table-name . column-name |
116             database-name . table-name . column-name |
117             literal-value |
118             function-name ( expr-list | * ) |
119             expr (+) |
120             expr ISNULL |
121             expr NOTNULL |
122             expr [NOT] BETWEEN expr AND expr |
123             expr [NOT] IN ( value-list ) |
124             expr [NOT] IN ( select-statement ) |
125             ( select-statement ) |
126             CASE [expr] ( WHEN expr THEN expr )+ [ELSE expr] END
127              
128             like-op::=
129             LIKE | GLOB | NOT LIKE | NOT GLOB
130              
131             =cut
132              
133 12     12   2344 use strict;
  12         23  
  12         316  
134 12     12   53 use warnings;
  12         26  
  12         653  
135              
136             our $VERSION = '1.6_3';
137              
138             our $DEBUG;
139             $DEBUG = 0 unless defined $DEBUG;
140              
141 12     12   560 use Data::Dumper;
  12         5588  
  12         575  
142 12     12   429 use SQL::Translator::Utils qw/ddl_parser_instance/;
  12         23  
  12         546  
143              
144 12     12   64 use base qw(Exporter);
  12         23  
  12         9443  
145             our @EXPORT_OK = qw(parse);
146              
147             our $GRAMMAR = <<'END_OF_GRAMMAR';
148              
149             {
150             my ( %tables, $table_order, @table_comments, @views, @triggers );
151              
152             sub _err {
153             my $max_lines = 5;
154             my @up_to_N_lines = split (/\n/, $_[1], $max_lines + 1);
155             die sprintf ("Unable to parse line %d:\n%s\n",
156             $_[0],
157             join "\n", (map { "'$_'" } @up_to_N_lines[0..$max_lines - 1 ]), @up_to_N_lines > $max_lines ? '...' : ()
158             );
159             }
160              
161             }
162              
163             #
164             # The "eofile" rule makes the parser fail if any "statement" rule
165             # fails. Otherwise, the first successful match by a "statement"
166             # won't cause the failure needed to know that the parse, as a whole,
167             # failed. -ky
168             #
169             startrule : statement(s) eofile {
170             $return = {
171             tables => \%tables,
172             views => \@views,
173             triggers => \@triggers,
174             }
175             }
176              
177             eofile : /^\Z/
178              
179             statement : begin_transaction
180             | commit
181             | drop
182             | comment
183             | create
184             | /^\Z/ | { _err ($thisline, $text) }
185              
186             begin_transaction : /begin/i TRANSACTION(?) SEMICOLON
187              
188             commit : /commit/i SEMICOLON
189              
190             drop : /drop/i (tbl_drop | view_drop | trg_drop) SEMICOLON
191              
192             tbl_drop: TABLE table_name
193              
194             view_drop: VIEW if_exists(?) view_name
195              
196             trg_drop: TRIGGER if_exists(?) trigger_name
197              
198             comment : /^\s*(?:#|-{2}).*\n/
199             {
200             my $comment = $item[1];
201             $comment =~ s/^\s*(#|-{2})\s*//;
202             $comment =~ s/\s*$//;
203             $return = $comment;
204             }
205              
206             comment : /\/\*/ /[^\*]+/ /\*\//
207             {
208             my $comment = $item[2];
209             $comment =~ s/^\s*|\s*$//g;
210             $return = $comment;
211             }
212              
213             #
214             # Create Index
215             #
216             create : CREATE TEMPORARY(?) UNIQUE(?) INDEX NAME ON table_name parens_field_list conflict_clause(?) SEMICOLON
217             {
218             my $db_name = $item[7]->{'db_name'} || '';
219             my $table_name = $item[7]->{'name'};
220              
221             my $index = {
222             name => $item[5],
223             fields => $item[8],
224             on_conflict => $item[9][0],
225             is_temporary => $item[2][0] ? 1 : 0,
226             };
227              
228             my $is_unique = $item[3][0];
229              
230             if ( $is_unique ) {
231             $index->{'type'} = 'unique';
232             push @{ $tables{ $table_name }{'constraints'} }, $index;
233             }
234             else {
235             push @{ $tables{ $table_name }{'indices'} }, $index;
236             }
237             }
238              
239             #
240             # Create Table
241             #
242             create : CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLON
243             {
244             my $db_name = $item[4]->{'db_name'} || '';
245             my $table_name = $item[4]->{'name'};
246              
247             $tables{ $table_name }{'name'} = $table_name;
248             $tables{ $table_name }{'is_temporary'} = $item[2][0] ? 1 : 0;
249             $tables{ $table_name }{'order'} = ++$table_order;
250              
251             for my $def ( @{ $item[6] } ) {
252             if ( $def->{'supertype'} eq 'column' ) {
253             push @{ $tables{ $table_name }{'fields'} }, $def;
254             }
255             elsif ( $def->{'supertype'} eq 'constraint' ) {
256             push @{ $tables{ $table_name }{'constraints'} }, $def;
257             }
258             }
259             }
260              
261             definition : constraint_def | column_def
262              
263             column_def: comment(s?) NAME type(?) column_constraint_def(s?)
264             {
265             my $column = {
266             supertype => 'column',
267             name => $item[2],
268             data_type => $item[3][0]->{'type'},
269             size => $item[3][0]->{'size'},
270             is_nullable => 1,
271             is_primary_key => 0,
272             is_unique => 0,
273             check => '',
274             default => undef,
275             constraints => $item[4],
276             comments => $item[1],
277             };
278              
279              
280             for my $c ( @{ $item[4] } ) {
281             if ( $c->{'type'} eq 'not_null' ) {
282             $column->{'is_nullable'} = 0;
283             }
284             elsif ( $c->{'type'} eq 'primary_key' ) {
285             $column->{'is_primary_key'} = 1;
286             }
287             elsif ( $c->{'type'} eq 'unique' ) {
288             $column->{'is_unique'} = 1;
289             }
290             elsif ( $c->{'type'} eq 'check' ) {
291             $column->{'check'} = $c->{'expression'};
292             }
293             elsif ( $c->{'type'} eq 'default' ) {
294             $column->{'default'} = $c->{'value'};
295             }
296             elsif ( $c->{'type'} eq 'autoincrement' ) {
297             $column->{'is_auto_inc'} = 1;
298             }
299             }
300              
301             $column;
302             }
303              
304             type : WORD parens_value_list(?)
305             {
306             $return = {
307             type => $item[1],
308             size => $item[2][0],
309             }
310             }
311              
312             column_constraint_def : CONSTRAINT constraint_name column_constraint
313             {
314             $return = {
315             name => $item[2],
316             %{ $item[3] },
317             }
318             }
319             |
320             column_constraint
321              
322             column_constraint : NOT_NULL conflict_clause(?)
323             {
324             $return = {
325             type => 'not_null',
326             }
327             }
328             |
329             PRIMARY_KEY sort_order(?) conflict_clause(?)
330             {
331             $return = {
332             type => 'primary_key',
333             sort_order => $item[2][0],
334             on_conflict => $item[2][0],
335             }
336             }
337             |
338             UNIQUE conflict_clause(?)
339             {
340             $return = {
341             type => 'unique',
342             on_conflict => $item[2][0],
343             }
344             }
345             |
346             CHECK_C '(' expr ')' conflict_clause(?)
347             {
348             $return = {
349             type => 'check',
350             expression => $item[3],
351             on_conflict => $item[5][0],
352             }
353             }
354             |
355             DEFAULT VALUE
356             {
357             $return = {
358             type => 'default',
359             value => $item[2],
360             }
361             }
362             |
363             REFERENCES ref_def cascade_def(?)
364             {
365             $return = {
366             type => 'foreign_key',
367             reference_table => $item[2]{'reference_table'},
368             reference_fields => $item[2]{'reference_fields'},
369             on_delete => $item[3][0]{'on_delete'},
370             on_update => $item[3][0]{'on_update'},
371             }
372             }
373             |
374             AUTOINCREMENT
375             {
376             $return = {
377             type => 'autoincrement',
378             }
379             }
380              
381             constraint_def : comment(s?) CONSTRAINT constraint_name table_constraint
382             {
383             $return = {
384             comments => $item[1],
385             name => $item[3],
386             %{ $item[4] },
387             }
388             }
389             |
390             comment(s?) table_constraint
391             {
392             $return = {
393             comments => $item[1],
394             %{ $item[2] },
395             }
396             }
397              
398             table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?)
399             {
400             $return = {
401             supertype => 'constraint',
402             type => 'primary_key',
403             fields => $item[2],
404             on_conflict => $item[3][0],
405             }
406             }
407             |
408             UNIQUE parens_field_list conflict_clause(?)
409             {
410             $return = {
411             supertype => 'constraint',
412             type => 'unique',
413             fields => $item[2],
414             on_conflict => $item[3][0],
415             }
416             }
417             |
418             CHECK_C '(' expr ')' conflict_clause(?)
419             {
420             $return = {
421             supertype => 'constraint',
422             type => 'check',
423             expression => $item[3],
424             on_conflict => $item[5][0],
425             }
426             }
427             |
428             FOREIGN_KEY parens_field_list REFERENCES ref_def cascade_def(?)
429             {
430             $return = {
431             supertype => 'constraint',
432             type => 'foreign_key',
433             fields => $item[2],
434             reference_table => $item[4]{'reference_table'},
435             reference_fields => $item[4]{'reference_fields'},
436             on_delete => $item[5][0]{'on_delete'},
437             on_update => $item[5][0]{'on_update'},
438             }
439             }
440              
441             ref_def : table_name parens_field_list
442             { $return = { reference_table => $item[1]{name}, reference_fields => $item[2] } }
443              
444             cascade_def : cascade_update_def cascade_delete_def(?)
445             { $return = { on_update => $item[1], on_delete => $item[2][0] } }
446             |
447             cascade_delete_def cascade_update_def(?)
448             { $return = { on_delete => $item[1], on_update => $item[2][0] } }
449              
450             cascade_delete_def : /on\s+delete\s+(set null|set default|cascade|restrict|no action)/i
451             { $return = $1}
452              
453             cascade_update_def : /on\s+update\s+(set null|set default|cascade|restrict|no action)/i
454             { $return = $1}
455              
456             table_name : qualified_name
457              
458             qualified_name : NAME
459             { $return = { name => $item[1] } }
460              
461             qualified_name : /(\w+)\.(\w+)/
462             { $return = { db_name => $1, name => $2 } }
463              
464             field_name : NAME
465              
466             constraint_name : NAME
467              
468             conflict_clause : /on conflict/i conflict_algorigthm
469              
470             conflict_algorigthm : /(rollback|abort|fail|ignore|replace)/i
471              
472             parens_field_list : '(' column_list ')'
473             { $item[2] }
474              
475             column_list : field_name(s /,/)
476              
477             parens_value_list : '(' VALUE(s /,/) ')'
478             { $item[2] }
479              
480             expr : /[^)]* \( [^)]+ \) [^)]*/x # parens, balanced one deep
481             | /[^)]+/
482              
483             sort_order : /(ASC|DESC)/i
484              
485             #
486             # Create Trigger
487              
488             create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action SEMICOLON
489             {
490             my $table_name = $item[8]->{'name'};
491             push @triggers, {
492             name => $item[4],
493             is_temporary => $item[2][0] ? 1 : 0,
494             when => $item[5][0],
495             instead_of => 0,
496             db_events => [ $item[6] ],
497             action => $item[9],
498             on_table => $table_name,
499             }
500             }
501              
502             create : CREATE TEMPORARY(?) TRIGGER NAME instead_of database_event ON view_name trigger_action
503             {
504             my $table_name = $item[8]->{'name'};
505             push @triggers, {
506             name => $item[4],
507             is_temporary => $item[2][0] ? 1 : 0,
508             when => undef,
509             instead_of => 1,
510             db_events => [ $item[6] ],
511             action => $item[9],
512             on_table => $table_name,
513             }
514             }
515              
516             database_event : /(delete|insert|update)/i
517              
518             database_event : /update of/i column_list
519              
520             trigger_action : for_each(?) when(?) BEGIN_C trigger_step(s) END_C
521             {
522             $return = {
523             for_each => $item[1][0],
524             when => $item[2][0],
525             steps => $item[4],
526             }
527             }
528              
529             for_each : /FOR EACH ROW/i
530              
531             when : WHEN expr { $item[2] }
532              
533             string :
534             /'(\.|''|[^\\'])*'/
535              
536             nonstring : /[^;\'"]+/
537              
538             statement_body : string | nonstring
539              
540             trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON
541             {
542             $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
543             }
544              
545             before_or_after : /(before|after)/i { $return = lc $1 }
546              
547             instead_of : /instead of/i
548              
549             if_exists : /if exists/i
550              
551             view_name : qualified_name
552              
553             trigger_name : qualified_name
554              
555             #
556             # Create View
557             #
558             create : CREATE TEMPORARY(?) VIEW view_name AS select_statement
559             {
560             push @views, {
561             name => $item[4]->{'name'},
562             sql => $item[6],
563             is_temporary => $item[2][0] ? 1 : 0,
564             }
565             }
566              
567             select_statement : SELECT /[^;]+/ SEMICOLON
568             {
569             $return = join( ' ', $item[1], $item[2] );
570             }
571              
572             #
573             # Tokens
574             #
575             BEGIN_C : /begin/i
576              
577             END_C : /end/i
578              
579             TRANSACTION: /transaction/i
580              
581             CREATE : /create/i
582              
583             TEMPORARY : /temp(orary)?/i { 1 }
584              
585             TABLE : /table/i
586              
587             INDEX : /index/i
588              
589             NOT_NULL : /not null/i
590              
591             PRIMARY_KEY : /primary key/i
592              
593             FOREIGN_KEY : /foreign key/i
594              
595             CHECK_C : /check/i
596              
597             DEFAULT : /default/i
598              
599             TRIGGER : /trigger/i
600              
601             VIEW : /view/i
602              
603             SELECT : /select/i
604              
605             ON : /on/i
606              
607             AS : /as/i
608              
609             WORD : /\w+/
610              
611             WHEN : /when/i
612              
613             REFERENCES : /references/i
614              
615             CONSTRAINT : /constraint/i
616              
617             AUTOINCREMENT : /autoincrement/i
618              
619             UNIQUE : /unique/i { 1 }
620              
621             SEMICOLON : ';'
622              
623             NAME : /\w+/
624             | DQSTRING
625             | SQSTRING
626              
627             DQSTRING : '"' /((?:[^"]|"")+)/ '"'
628             { ($return = $item[3]) =~ s/""/"/g }
629              
630             SQSTRING : "'" /((?:[^']|'')*)/ "'"
631             { ($return = $item[3]) =~ s/''/'/g }
632              
633             VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/
634             { $item[1] }
635             | SQSTRING
636             | /NULL/i
637             { 'NULL' }
638             | /CURRENT_TIMESTAMP/i
639             { 'CURRENT_TIMESTAMP' }
640              
641             END_OF_GRAMMAR
642              
643              
644             sub parse {
645 15     15 0 87 my ( $translator, $data ) = @_;
646              
647             # Enable warnings within the Parse::RecDescent module.
648 15 100       57 local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
649 15 100       50 local $::RD_WARN = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
650 15 50       52 local $::RD_HINT = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.
651              
652 15 50       252 local $::RD_TRACE = $translator->trace ? 1 : undef;
653 15         187 local $DEBUG = $translator->debug;
654              
655 15         151 my $parser = ddl_parser_instance('SQLite');
656              
657 15         5277819 my $result = $parser->startrule($data);
658 15 50       1229026 return $translator->error( "Parse failed." ) unless defined $result;
659 15 50       84 warn Dumper( $result ) if $DEBUG;
660              
661 15         389 my $schema = $translator->schema;
662             my @tables =
663 27         84 map { $_->[1] }
664 13         55 sort { $a->[0] <=> $b->[0] }
665 27         134 map { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] }
666 15         1049 keys %{ $result->{'tables'} };
  15         78  
667              
668 15         194 for my $table_name ( @tables ) {
669 27         70 my $tdata = $result->{'tables'}{ $table_name };
670             my $table = $schema->add_table(
671 27 50       149 name => $tdata->{'name'},
672             ) or die $schema->error;
673              
674 27         1031 $table->comments( $tdata->{'comments'} );
675              
676 27         66 for my $fdata ( @{ $tdata->{'fields'} } ) {
  27         105  
677             my $field = $table->add_field(
678             name => $fdata->{'name'},
679             data_type => $fdata->{'data_type'},
680             size => $fdata->{'size'},
681             default_value => $fdata->{'default'},
682             is_auto_increment => $fdata->{'is_auto_inc'},
683             is_nullable => $fdata->{'is_nullable'},
684 124 50       618 comments => $fdata->{'comments'},
685             ) or die $table->error;
686              
687 124 100       2430 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
688              
689 124         187 for my $cdata ( @{ $fdata->{'constraints'} } ) {
  124         355  
690 74 100       250 next unless $cdata->{'type'} eq 'foreign_key';
691 11   50     252 $cdata->{'fields'} ||= [ $field->name ];
692 11         190 push @{ $tdata->{'constraints'} }, $cdata;
  11         43  
693             }
694             }
695              
696 27 100       76 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
  27         146  
697             my $index = $table->add_index(
698             name => $idata->{'name'},
699             type => uc ($idata->{'type'}||''),
700 1 50 50     11 fields => $idata->{'fields'},
701             ) or die $table->error;
702             }
703              
704 27 100       64 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
  27         134  
705             my $constraint = $table->add_constraint(
706             name => $cdata->{'name'},
707             type => $cdata->{'type'},
708             fields => $cdata->{'fields'},
709             reference_table => $cdata->{'reference_table'},
710             reference_fields => $cdata->{'reference_fields'},
711             match_type => $cdata->{'match_type'} || '',
712             on_delete => $cdata->{'on_delete'}
713             || $cdata->{'on_delete_do'},
714             on_update => $cdata->{'on_update'}
715 42 50 50     456 || $cdata->{'on_update_do'},
      66        
      66        
716             ) or die $table->error;
717             }
718             }
719              
720 15 50       45 for my $def ( @{ $result->{'views'} || [] } ) {
  15         77  
721             my $view = $schema->add_view(
722             name => $def->{'name'},
723 10         66 sql => $def->{'sql'},
724             );
725             }
726              
727 15 50       113 for my $def ( @{ $result->{'triggers'} || [] } ) {
  15         72  
728             my $view = $schema->add_trigger(
729             name => $def->{'name'},
730             perform_action_when => $def->{'when'},
731             database_events => $def->{'db_events'},
732             action => $def->{'action'},
733 13         80 on_table => $def->{'on_table'},
734             scope => 'row', # SQLite only supports row triggers
735             );
736             }
737              
738 15         152 return 1;
739             }
740              
741             1;
742              
743             # -------------------------------------------------------------------
744             # All wholesome food is caught without a net or a trap.
745             # William Blake
746             # -------------------------------------------------------------------
747              
748             =pod
749              
750             =head1 AUTHOR
751              
752             Ken Youens-Clark Ekclark@cpan.orgE.
753              
754             =head1 SEE ALSO
755              
756             perl(1), Parse::RecDescent, SQL::Translator::Schema.
757              
758             =cut