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 our ( $DEBUG, $GRAMMAR, @EXPORT_OK );
 136 our $VERSION = '1.59';
 137 $DEBUG   = 0 unless defined $DEBUG;
 138
 139 use Data::Dumper;
 140 use Parse::RecDescent;
 141 use Exporter;
 142 use base qw(Exporter);
 143
 144 @EXPORT_OK = qw(parse);
 145
 146 # Enable warnings within the Parse::RecDescent module.
 147 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
 148 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
 149 $::RD_HINT   = 1; # Give out hints to help fix problems.
 150
 151 $GRAMMAR = q!
 152
 153 {
 154     my ( %tables, $table_order, @table_comments, @views, @triggers );
 155
 156     sub _err {
 157       my $max_lines = 5;
 158       my @up_to_N_lines = split (/\n/, $_[1], $max_lines + 1);
 159       die sprintf ("Unable to parse line %d:\n%s\n",
 160         $_[0],
 161         join "\n", (map { "'$_'" } @up_to_N_lines[0..$max_lines - 1 ]), @up_to_N_lines > $max_lines ? '...' : ()
 162       );
 163     }
 164
 165 }
 166
 167 #
 168 # The "eofile" rule makes the parser fail if any "statement" rule
 169 # fails.  Otherwise, the first successful match by a "statement"
 170 # won't cause the failure needed to know that the parse, as a whole,
 171 # failed. -ky
 172 #
 173 startrule : statement(s) eofile {
 174     $return      = {
 175         tables   => \%tables,
 176         views    => \@views,
 177         triggers => \@triggers,
 178     }
 179 }
 180
 181 eofile : /^\Z/
 182
 183 statement : begin_transaction
 184     | commit
 185     | drop
 186     | comment
 187     | create
 188     | /^\Z/ | { _err ($thisline, $text) }
 189
 190 begin_transaction : /begin/i TRANSACTION(?) SEMICOLON
 191
 192 commit : /commit/i SEMICOLON
 193
 194 drop : /drop/i (tbl_drop | view_drop | trg_drop) SEMICOLON
 195
 196 tbl_drop: TABLE <commit> table_name
 197
 198 view_drop: VIEW if_exists(?) view_name
 199
 200 trg_drop: TRIGGER if_exists(?) trigger_name
 201
 202 comment : /^\s*(?:#|-{2}).*\n/
 203     {
 204         my $comment =  $item[1];
 205         $comment    =~ s/^\s*(#|-{2})\s*//;
 206         $comment    =~ s/\s*$//;
 207         $return     = $comment;
 208     }
 209
 210 comment : /\/\*/ /[^\*]+/ /\*\//
 211     {
 212         my $comment = $item[2];
 213         $comment    =~ s/^\s*|\s*$//g;
 214         $return = $comment;
 215     }
 216
 217 #
 218 # Create Index
 219 #
 220 create : CREATE TEMPORARY(?) UNIQUE(?) INDEX NAME ON table_name parens_field_list conflict_clause(?) SEMICOLON
 221     {
 222         my $db_name    = $item[7]->{'db_name'} || '';
 223         my $table_name = $item[7]->{'name'};
 224
 225         my $index        =  {
 226             name         => $item[5],
 227             fields       => $item[8],
 228             on_conflict  => $item[9][0],
 229             is_temporary => $item[2][0] ? 1 : 0,
 230         };
 231
 232         my $is_unique = $item[3][0];
 233
 234         if ( $is_unique ) {
 235             $index->{'type'} = 'unique';
 236             push @{ $tables{ $table_name }{'constraints'} }, $index;
 237         }
 238         else {
 239             push @{ $tables{ $table_name }{'indices'} }, $index;
 240         }
 241     }
 242
 243 #
 244 # Create Table
 245 #
 246 create : CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLON
 247     {
 248         my $db_name    = $item[4]->{'db_name'} || '';
 249         my $table_name = $item[4]->{'name'};
 250
 251         $tables{ $table_name }{'name'}         = $table_name;
 252         $tables{ $table_name }{'is_temporary'} = $item[2][0] ? 1 : 0;
 253         $tables{ $table_name }{'order'}        = ++$table_order;
 254
 255         for my $def ( @{ $item[6] } ) {
 256             if ( $def->{'supertype'} eq 'column' ) {
 257                 push @{ $tables{ $table_name }{'fields'} }, $def;
 258             }
 259             elsif ( $def->{'supertype'} eq 'constraint' ) {
 260                 push @{ $tables{ $table_name }{'constraints'} }, $def;
 261             }
 262         }
 263     }
 264
 265 definition : constraint_def | column_def
 266
 267 column_def: comment(s?) NAME type(?) column_constraint_def(s?)
 268     {
 269         my $column = {
 270             supertype      => 'column',
 271             name           => $item[2],
 272             data_type      => $item[3][0]->{'type'},
 273             size           => $item[3][0]->{'size'},
 274             is_nullable    => 1,
 275             is_primary_key => 0,
 276             is_unique      => 0,
 277             check          => '',
 278             default        => undef,
 279             constraints    => $item[4],
 280             comments       => $item[1],
 281         };
 282
 283
 284         for my $c ( @{ $item[4] } ) {
 285             if ( $c->{'type'} eq 'not_null' ) {
 286                 $column->{'is_nullable'} = 0;
 287             }
 288             elsif ( $c->{'type'} eq 'primary_key' ) {
 289                 $column->{'is_primary_key'} = 1;
 290             }
 291             elsif ( $c->{'type'} eq 'unique' ) {
 292                 $column->{'is_unique'} = 1;
 293             }
 294             elsif ( $c->{'type'} eq 'check' ) {
 295                 $column->{'check'} = $c->{'expression'};
 296             }
 297             elsif ( $c->{'type'} eq 'default' ) {
 298                 $column->{'default'} = $c->{'value'};
 299             }
 300             elsif ( $c->{'type'} eq 'autoincrement' ) {
 301                 $column->{'is_auto_inc'} = 1;
 302             }
 303         }
 304
 305         $column;
 306     }
 307
 308 type : WORD parens_value_list(?)
 309     {
 310         $return = {
 311             type => $item[1],
 312             size => $item[2][0],
 313         }
 314     }
 315
 316 column_constraint_def : CONSTRAINT constraint_name column_constraint
 317     {
 318         $return = {
 319             name => $item[2],
 320             %{ $item[3] },
 321         }
 322     }
 323     |
 324     column_constraint
 325
 326 column_constraint : NOT_NULL conflict_clause(?)
 327     {
 328         $return = {
 329             type => 'not_null',
 330         }
 331     }
 332     |
 333     PRIMARY_KEY sort_order(?) conflict_clause(?)
 334     {
 335         $return = {
 336             type        => 'primary_key',
 337             sort_order  => $item[2][0],
 338             on_conflict => $item[2][0],
 339         }
 340     }
 341     |
 342     UNIQUE conflict_clause(?)
 343     {
 344         $return = {
 345             type        => 'unique',
 346             on_conflict => $item[2][0],
 347         }
 348     }
 349     |
 350     CHECK_C '(' expr ')' conflict_clause(?)
 351     {
 352         $return = {
 353             type        => 'check',
 354             expression  => $item[3],
 355             on_conflict => $item[5][0],
 356         }
 357     }
 358     |
 359     DEFAULT VALUE
 360     {
 361         $return   = {
 362             type  => 'default',
 363             value => $item[2],
 364         }
 365     }
 366     |
 367     REFERENCES ref_def
 368     {
 369         $return   = {
 370             type             => 'foreign_key',
 371             reference_table  => $item[2]{'reference_table'},
 372             reference_fields => $item[2]{'reference_fields'},
 373         }
 374     }
 375     |
 376     AUTOINCREMENT
 377     {
 378         $return = {
 379             type => 'autoincrement',
 380         }
 381     }
 382
 383 constraint_def : comment(s?) CONSTRAINT constraint_name table_constraint
 384     {
 385         $return = {
 386             comments => $item[1],
 387             name => $item[3],
 388             %{ $item[4] },
 389         }
 390     }
 391     |
 392     comment(s?) table_constraint
 393     {
 394         $return = {
 395             comments => $item[1],
 396             %{ $item[2] },
 397         }
 398     }
 399
 400 table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?)
 401     {
 402         $return         = {
 403             supertype   => 'constraint',
 404             type        => 'primary_key',
 405             fields      => $item[2],
 406             on_conflict => $item[3][0],
 407         }
 408     }
 409     |
 410     UNIQUE parens_field_list conflict_clause(?)
 411     {
 412         $return         = {
 413             supertype   => 'constraint',
 414             type        => 'unique',
 415             fields      => $item[2],
 416             on_conflict => $item[3][0],
 417         }
 418     }
 419     |
 420     CHECK_C '(' expr ')' conflict_clause(?)
 421     {
 422         $return         = {
 423             supertype   => 'constraint',
 424             type        => 'check',
 425             expression  => $item[3],
 426             on_conflict => $item[5][0],
 427         }
 428     }
 429     |
 430     FOREIGN_KEY parens_field_list REFERENCES ref_def
 431     {
 432       $return = {
 433         supertype        => 'constraint',
 434         type             => 'foreign_key',
 435         fields           => $item[2],
 436         reference_table  => $item[4]{'reference_table'},
 437         reference_fields => $item[4]{'reference_fields'},
 438       }
 439     }
 440
 441 ref_def : /(\w+)\s*\((\w+)\)/
 442     { $return = { reference_table => $1, reference_fields => $2 } }
 443
 444 table_name : qualified_name
 445
 446 qualified_name : NAME
 447     { $return = { name => $item[1] } }
 448
 449 qualified_name : /(\w+)\.(\w+)/
 450     { $return = { db_name => $1, name => $2 } }
 451
 452 field_name : NAME
 453
 454 constraint_name : NAME
 455
 456 conflict_clause : /on conflict/i conflict_algorigthm
 457
 458 conflict_algorigthm : /(rollback|abort|fail|ignore|replace)/i
 459
 460 parens_field_list : '(' column_list ')'
 461     { $item[2] }
 462
 463 column_list : field_name(s /,/)
 464
 465 parens_value_list : '(' VALUE(s /,/) ')'
 466     { $item[2] }
 467
 468 expr : /[^)]+/
 469
 470 sort_order : /(ASC|DESC)/i
 471
 472 #
 473 # Create Trigger
 474
 475 create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action SEMICOLON
 476     {
 477         my $table_name = $item[8]->{'name'};
 478         push @triggers, {
 479             name         => $item[4],
 480             is_temporary => $item[2][0] ? 1 : 0,
 481             when         => $item[5][0],
 482             instead_of   => 0,
 483             db_events    => [ $item[6] ],
 484             action       => $item[9],
 485             on_table     => $table_name,
 486         }
 487     }
 488
 489 create : CREATE TEMPORARY(?) TRIGGER NAME instead_of database_event ON view_name trigger_action
 490     {
 491         my $table_name = $item[8]->{'name'};
 492         push @triggers, {
 493             name         => $item[4],
 494             is_temporary => $item[2][0] ? 1 : 0,
 495             when         => undef,
 496             instead_of   => 1,
 497             db_events    => [ $item[6] ],
 498             action       => $item[9],
 499             on_table     => $table_name,
 500         }
 501     }
 502
 503 database_event : /(delete|insert|update)/i
 504
 505 database_event : /update of/i column_list
 506
 507 trigger_action : for_each(?) when(?) BEGIN_C trigger_step(s) END_C
 508     {
 509         $return = {
 510             for_each => $item[1][0],
 511             when     => $item[2][0],
 512             steps    => $item[4],
 513         }
 514     }
 515
 516 for_each : /FOR EACH ROW/i
 517
 518 when : WHEN expr { $item[2] }
 519
 520 string :
 521    /'(\\.|''|[^\\\'])*'/
 522
 523 nonstring : /[^;\'"]+/
 524
 525 statement_body : string | nonstring
 526
 527 trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON
 528     {
 529         $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
 530     }
 531
 532 before_or_after : /(before|after)/i { $return = lc $1 }
 533
 534 instead_of : /instead of/i
 535
 536 if_exists : /if exists/i
 537
 538 view_name : qualified_name
 539
 540 trigger_name : qualified_name
 541
 542 #
 543 # Create View
 544 #
 545 create : CREATE TEMPORARY(?) VIEW view_name AS select_statement
 546     {
 547         push @views, {
 548             name         => $item[4]->{'name'},
 549             sql          => $item[6],
 550             is_temporary => $item[2][0] ? 1 : 0,
 551         }
 552     }
 553
 554 select_statement : SELECT /[^;]+/ SEMICOLON
 555     {
 556         $return = join( ' ', $item[1], $item[2] );
 557     }
 558
 559 #
 560 # Tokens
 561 #
 562 BEGIN_C : /begin/i
 563
 564 END_C : /end/i
 565
 566 TRANSACTION: /transaction/i
 567
 568 CREATE : /create/i
 569
 570 TEMPORARY : /temp(orary)?/i { 1 }
 571
 572 TABLE : /table/i
 573
 574 INDEX : /index/i
 575
 576 NOT_NULL : /not null/i
 577
 578 PRIMARY_KEY : /primary key/i
 579
 580 FOREIGN_KEY : /foreign key/i
 581
 582 CHECK_C : /check/i
 583
 584 DEFAULT : /default/i
 585
 586 TRIGGER : /trigger/i
 587
 588 VIEW : /view/i
 589
 590 SELECT : /select/i
 591
 592 ON : /on/i
 593
 594 AS : /as/i
 595
 596 WORD : /\w+/
 597
 598 WHEN : /when/i
 599
 600 REFERENCES : /references/i
 601
 602 CONSTRAINT : /constraint/i
 603
 604 AUTOINCREMENT : /autoincrement/i
 605
 606 UNIQUE : /unique/i { 1 }
 607
 608 SEMICOLON : ';'
 609
 610 NAME : /["']?(\w+)["']?/ { $return = $1 }
 611
 612 VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
 613     { $item[1] }
 614     | /'.*?'/
 615     {
 616         # remove leading/trailing quotes
 617         my $val = $item[1];
 618         $val    =~ s/^['"]|['"]$//g;
 619         $return = $val;
 620     }
 621     | /NULL/
 622     { 'NULL' }
 623     | /CURRENT_TIMESTAMP/i
 624     { 'CURRENT_TIMESTAMP' }
 625
 626 !;
 627
 628 sub parse {
 629     my ( $translator, $data ) = @_;
 630     my $parser = Parse::RecDescent->new($GRAMMAR);
 631
 632     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 633     local $DEBUG       = $translator->debug;
 634
 635     unless (defined $parser) {
 636         return $translator->error("Error instantiating Parse::RecDescent ".
 637             "instance: Bad grammer");
 638     }
 639
 640     my $result = $parser->startrule($data);
 641     return $translator->error( "Parse failed." ) unless defined $result;
 642     warn Dumper( $result ) if $DEBUG;
 643
 644     my $schema = $translator->schema;
 645     my @tables =
 646         map   { $_->[1] }
 647         sort  { $a->[0] <=> $b->[0] }
 648         map   { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] }
 649         keys %{ $result->{'tables'} };
 650
 651     for my $table_name ( @tables ) {
 652         my $tdata =  $result->{'tables'}{ $table_name };
 653         my $table =  $schema->add_table(
 654             name  => $tdata->{'name'},
 655         ) or die $schema->error;
 656
 657         $table->comments( $tdata->{'comments'} );
 658
 659         for my $fdata ( @{ $tdata->{'fields'} } ) {
 660             my $field = $table->add_field(
 661                 name              => $fdata->{'name'},
 662                 data_type         => $fdata->{'data_type'},
 663                 size              => $fdata->{'size'},
 664                 default_value     => $fdata->{'default'},
 665                 is_auto_increment => $fdata->{'is_auto_inc'},
 666                 is_nullable       => $fdata->{'is_nullable'},
 667                 comments          => $fdata->{'comments'},
 668             ) or die $table->error;
 669
 670             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 671
 672             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 673                 next unless $cdata->{'type'} eq 'foreign_key';
 674                 $cdata->{'fields'} ||= [ $field->name ];
 675                 push @{ $tdata->{'constraints'} }, $cdata;
 676             }
 677         }
 678
 679         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 680             my $index  =  $table->add_index(
 681                 name   => $idata->{'name'},
 682                 type   => uc ($idata->{'type'}||''),
 683                 fields => $idata->{'fields'},
 684             ) or die $table->error;
 685         }
 686
 687         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 688             my $constraint       =  $table->add_constraint(
 689                 name             => $cdata->{'name'},
 690                 type             => $cdata->{'type'},
 691                 fields           => $cdata->{'fields'},
 692                 reference_table  => $cdata->{'reference_table'},
 693                 reference_fields => $cdata->{'reference_fields'},
 694                 match_type       => $cdata->{'match_type'} || '',
 695                 on_delete        => $cdata->{'on_delete'}
 696                                  || $cdata->{'on_delete_do'},
 697                 on_update        => $cdata->{'on_update'}
 698                                  || $cdata->{'on_update_do'},
 699             ) or die $table->error;
 700         }
 701     }
 702
 703     for my $def ( @{ $result->{'views'} || [] } ) {
 704         my $view = $schema->add_view(
 705             name => $def->{'name'},
 706             sql  => $def->{'sql'},
 707         );
 708     }
 709
 710     for my $def ( @{ $result->{'triggers'} || [] } ) {
 711         my $view                = $schema->add_trigger(
 712             name                => $def->{'name'},
 713             perform_action_when => $def->{'when'},
 714             database_events     => $def->{'db_events'},
 715             action              => $def->{'action'},
 716             on_table            => $def->{'on_table'},
 717         );
 718     }
 719
 720     return 1;
 721 }
 722
 723 1;
 724
 725 # -------------------------------------------------------------------
 726 # All wholsome food is caught without a net or a trap.
 727 # William Blake
 728 # -------------------------------------------------------------------
 729
 730 =pod
 731
 732 =head1 AUTHOR
 733
 734 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 735
 736 =head1 SEE ALSO
 737
 738 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 739
 740 =cut