lib/SQL/Translator/Parser/SQLite.pm

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