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