lib/SQL/Translator/Parser/SQLite.pm

   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 use strict;
 134 use warnings;
 135
 136 our $VERSION = '1.59';
 137
 138 our $DEBUG;
 139 $DEBUG   = 0 unless defined $DEBUG;
 140
 141 use Data::Dumper;
 142 use SQL::Translator::Utils qw/ddl_parser_instance/;
 143
 144 use base qw(Exporter);
 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 <commit> 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 : /[^)]+/
 481
 482 sort_order : /(ASC|DESC)/i
 483
 484 #
 485 # Create Trigger
 486
 487 create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action SEMICOLON
 488     {
 489         my $table_name = $item[8]->{'name'};
 490         push @triggers, {
 491             name         => $item[4],
 492             is_temporary => $item[2][0] ? 1 : 0,
 493             when         => $item[5][0],
 494             instead_of   => 0,
 495             db_events    => [ $item[6] ],
 496             action       => $item[9],
 497             on_table     => $table_name,
 498         }
 499     }
 500
 501 create : CREATE TEMPORARY(?) TRIGGER NAME instead_of database_event ON view_name trigger_action
 502     {
 503         my $table_name = $item[8]->{'name'};
 504         push @triggers, {
 505             name         => $item[4],
 506             is_temporary => $item[2][0] ? 1 : 0,
 507             when         => undef,
 508             instead_of   => 1,
 509             db_events    => [ $item[6] ],
 510             action       => $item[9],
 511             on_table     => $table_name,
 512         }
 513     }
 514
 515 database_event : /(delete|insert|update)/i
 516
 517 database_event : /update of/i column_list
 518
 519 trigger_action : for_each(?) when(?) BEGIN_C trigger_step(s) END_C
 520     {
 521         $return = {
 522             for_each => $item[1][0],
 523             when     => $item[2][0],
 524             steps    => $item[4],
 525         }
 526     }
 527
 528 for_each : /FOR EACH ROW/i
 529
 530 when : WHEN expr { $item[2] }
 531
 532 string :
 533    /'(\.|''|[^\\'])*'/
 534
 535 nonstring : /[^;\'"]+/
 536
 537 statement_body : string | nonstring
 538
 539 trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON
 540     {
 541         $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
 542     }
 543
 544 before_or_after : /(before|after)/i { $return = lc $1 }
 545
 546 instead_of : /instead of/i
 547
 548 if_exists : /if exists/i
 549
 550 view_name : qualified_name
 551
 552 trigger_name : qualified_name
 553
 554 #
 555 # Create View
 556 #
 557 create : CREATE TEMPORARY(?) VIEW view_name AS select_statement
 558     {
 559         push @views, {
 560             name         => $item[4]->{'name'},
 561             sql          => $item[6],
 562             is_temporary => $item[2][0] ? 1 : 0,
 563         }
 564     }
 565
 566 select_statement : SELECT /[^;]+/ SEMICOLON
 567     {
 568         $return = join( ' ', $item[1], $item[2] );
 569     }
 570
 571 #
 572 # Tokens
 573 #
 574 BEGIN_C : /begin/i
 575
 576 END_C : /end/i
 577
 578 TRANSACTION: /transaction/i
 579
 580 CREATE : /create/i
 581
 582 TEMPORARY : /temp(orary)?/i { 1 }
 583
 584 TABLE : /table/i
 585
 586 INDEX : /index/i
 587
 588 NOT_NULL : /not null/i
 589
 590 PRIMARY_KEY : /primary key/i
 591
 592 FOREIGN_KEY : /foreign key/i
 593
 594 CHECK_C : /check/i
 595
 596 DEFAULT : /default/i
 597
 598 TRIGGER : /trigger/i
 599
 600 VIEW : /view/i
 601
 602 SELECT : /select/i
 603
 604 ON : /on/i
 605
 606 AS : /as/i
 607
 608 WORD : /\w+/
 609
 610 WHEN : /when/i
 611
 612 REFERENCES : /references/i
 613
 614 CONSTRAINT : /constraint/i
 615
 616 AUTOINCREMENT : /autoincrement/i
 617
 618 UNIQUE : /unique/i { 1 }
 619
 620 SEMICOLON : ';'
 621
 622 NAME : /\w+/
 623     | DQSTRING
 624     | SQSTRING
 625
 626 DQSTRING : '"' <skip: ''> /((?:[^"]|"")+)/ '"'
 627     { ($return = $item[3]) =~ s/""/"/g }
 628
 629 SQSTRING : "'" <skip: ''> /((?:[^']|'')*)/ "'"
 630     { ($return = $item[3]) =~ s/''/'/g }
 631
 632 VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/
 633     { $item[1] }
 634     | SQSTRING
 635     | /NULL/i
 636     { 'NULL' }
 637     | /CURRENT_TIMESTAMP/i
 638     { 'CURRENT_TIMESTAMP' }
 639
 640 END_OF_GRAMMAR
 641
 642
 643 sub parse {
 644     my ( $translator, $data ) = @_;
 645
 646     # Enable warnings within the Parse::RecDescent module.
 647     local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
 648     local $::RD_WARN   = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
 649     local $::RD_HINT   = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.
 650
 651     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 652     local $DEBUG       = $translator->debug;
 653
 654     my $parser = ddl_parser_instance('SQLite');
 655
 656     my $result = $parser->startrule($data);
 657     return $translator->error( "Parse failed." ) unless defined $result;
 658     warn Dumper( $result ) if $DEBUG;
 659
 660     my $schema = $translator->schema;
 661     my @tables =
 662         map   { $_->[1] }
 663         sort  { $a->[0] <=> $b->[0] }
 664         map   { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] }
 665         keys %{ $result->{'tables'} };
 666
 667     for my $table_name ( @tables ) {
 668         my $tdata =  $result->{'tables'}{ $table_name };
 669         my $table =  $schema->add_table(
 670             name  => $tdata->{'name'},
 671         ) or die $schema->error;
 672
 673         $table->comments( $tdata->{'comments'} );
 674
 675         for my $fdata ( @{ $tdata->{'fields'} } ) {
 676             my $field = $table->add_field(
 677                 name              => $fdata->{'name'},
 678                 data_type         => $fdata->{'data_type'},
 679                 size              => $fdata->{'size'},
 680                 default_value     => $fdata->{'default'},
 681                 is_auto_increment => $fdata->{'is_auto_inc'},
 682                 is_nullable       => $fdata->{'is_nullable'},
 683                 comments          => $fdata->{'comments'},
 684             ) or die $table->error;
 685
 686             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 687
 688             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 689                 next unless $cdata->{'type'} eq 'foreign_key';
 690                 $cdata->{'fields'} ||= [ $field->name ];
 691                 push @{ $tdata->{'constraints'} }, $cdata;
 692             }
 693         }
 694
 695         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 696             my $index  =  $table->add_index(
 697                 name   => $idata->{'name'},
 698                 type   => uc ($idata->{'type'}||''),
 699                 fields => $idata->{'fields'},
 700             ) or die $table->error;
 701         }
 702
 703         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 704             my $constraint       =  $table->add_constraint(
 705                 name             => $cdata->{'name'},
 706                 type             => $cdata->{'type'},
 707                 fields           => $cdata->{'fields'},
 708                 reference_table  => $cdata->{'reference_table'},
 709                 reference_fields => $cdata->{'reference_fields'},
 710                 match_type       => $cdata->{'match_type'} || '',
 711                 on_delete        => $cdata->{'on_delete'}
 712                                  || $cdata->{'on_delete_do'},
 713                 on_update        => $cdata->{'on_update'}
 714                                  || $cdata->{'on_update_do'},
 715             ) or die $table->error;
 716         }
 717     }
 718
 719     for my $def ( @{ $result->{'views'} || [] } ) {
 720         my $view = $schema->add_view(
 721             name => $def->{'name'},
 722             sql  => $def->{'sql'},
 723         );
 724     }
 725
 726     for my $def ( @{ $result->{'triggers'} || [] } ) {
 727         my $view                = $schema->add_trigger(
 728             name                => $def->{'name'},
 729             perform_action_when => $def->{'when'},
 730             database_events     => $def->{'db_events'},
 731             action              => $def->{'action'},
 732             on_table            => $def->{'on_table'},
 733             scope               => 'row', # SQLite only supports row triggers
 734         );
 735     }
 736
 737     return 1;
 738 }
 739
 740 1;
 741
 742 # -------------------------------------------------------------------
 743 # All wholesome food is caught without a net or a trap.
 744 # William Blake
 745 # -------------------------------------------------------------------
 746
 747 =pod
 748
 749 =head1 AUTHOR
 750
 751 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 752
 753 =head1 SEE ALSO
 754
 755 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 756
 757 =cut