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 NAME 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_def(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             elsif ( $c->{'type'} eq 'autoincrement' ) {
 308                 $column->{'is_auto_inc'} = 1;
 309             }
 310         }
 311
 312         $column;
 313     }
 314
 315 type : WORD parens_value_list(?)
 316     {
 317         $return = {
 318             type => $item[1],
 319             size => $item[2][0],
 320         }
 321     }
 322
 323 column_constraint_def : CONSTRAINT constraint_name column_constraint
 324     {
 325         $return = {
 326             name => $item[2],
 327             %{ $item[3] },
 328         }
 329     }
 330     |
 331     column_constraint
 332
 333 column_constraint : NOT_NULL conflict_clause(?)
 334     {
 335         $return = {
 336             type => 'not_null',
 337         }
 338     }
 339     |
 340     PRIMARY_KEY sort_order(?) conflict_clause(?)
 341     {
 342         $return = {
 343             type        => 'primary_key',
 344             sort_order  => $item[2][0],
 345             on_conflict => $item[2][0],
 346         }
 347     }
 348     |
 349     UNIQUE conflict_clause(?)
 350     {
 351         $return = {
 352             type        => 'unique',
 353             on_conflict => $item[2][0],
 354         }
 355     }
 356     |
 357     CHECK_C '(' expr ')' conflict_clause(?)
 358     {
 359         $return = {
 360             type        => 'check',
 361             expression  => $item[3],
 362             on_conflict => $item[5][0],
 363         }
 364     }
 365     |
 366     DEFAULT VALUE
 367     {
 368         $return   = {
 369             type  => 'default',
 370             value => $item[2],
 371         }
 372     }
 373     |
 374     REFERENCES ref_def
 375     {
 376         $return   = {
 377             type             => 'foreign_key',
 378             reference_table  => $item[2]{'reference_table'},
 379             reference_fields => $item[2]{'reference_fields'},
 380         }
 381     }
 382     |
 383     AUTOINCREMENT
 384     {
 385         $return = {
 386             type => 'autoincrement',
 387         }
 388     }
 389
 390 constraint_def : comment(s?) CONSTRAINT constraint_name table_constraint
 391     {
 392         $return = {
 393             comments => $item[1],
 394             name => $item[3],
 395             %{ $item[4] },
 396         }
 397     }
 398     |
 399     comment(s?) table_constraint
 400     {
 401         $return = {
 402             comments => $item[1],
 403             %{ $item[2] },
 404         }
 405     }
 406
 407 table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?)
 408     {
 409         $return         = {
 410             supertype   => 'constraint',
 411             type        => 'primary_key',
 412             fields      => $item[2],
 413             on_conflict => $item[3][0],
 414         }
 415     }
 416     |
 417     UNIQUE parens_field_list conflict_clause(?)
 418     {
 419         $return         = {
 420             supertype   => 'constraint',
 421             type        => 'unique',
 422             fields      => $item[2],
 423             on_conflict => $item[3][0],
 424         }
 425     }
 426     |
 427     CHECK_C '(' expr ')' conflict_clause(?)
 428     {
 429         $return         = {
 430             supertype   => 'constraint',
 431             type        => 'check',
 432             expression  => $item[3],
 433             on_conflict => $item[5][0],
 434         }
 435     }
 436     |
 437     FOREIGN_KEY parens_field_list REFERENCES ref_def
 438     {
 439       $return = {
 440         supertype        => 'constraint',
 441         type             => 'foreign_key',
 442         fields           => $item[2],
 443         reference_table  => $item[4]{'reference_table'},
 444         reference_fields => $item[4]{'reference_fields'},
 445       }
 446     }
 447
 448 ref_def : /(\w+)\s*\((\w+)\)/
 449     { $return = { reference_table => $1, reference_fields => $2 } }
 450
 451 table_name : qualified_name
 452
 453 qualified_name : NAME
 454     { $return = { name => $item[1] } }
 455
 456 qualified_name : /(\w+)\.(\w+)/
 457     { $return = { db_name => $1, name => $2 } }
 458
 459 field_name : NAME
 460
 461 constraint_name : NAME
 462
 463 conflict_clause : /on conflict/i conflict_algorigthm
 464
 465 conflict_algorigthm : /(rollback|abort|fail|ignore|replace)/i
 466
 467 parens_field_list : '(' column_list ')'
 468     { $item[2] }
 469
 470 column_list : field_name(s /,/)
 471
 472 parens_value_list : '(' VALUE(s /,/) ')'
 473     { $item[2] }
 474
 475 expr : /[^)]+/
 476
 477 sort_order : /(ASC|DESC)/i
 478
 479 #
 480 # Create Trigger
 481
 482 create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action SEMICOLON
 483     {
 484         my $table_name = $item[8]->{'name'};
 485         push @triggers, {
 486             name         => $item[4],
 487             is_temporary => $item[2][0] ? 1 : 0,
 488             when         => $item[5][0],
 489             instead_of   => 0,
 490             db_events    => [ $item[6] ],
 491             action       => $item[9],
 492             on_table     => $table_name,
 493         }
 494     }
 495
 496 create : CREATE TEMPORARY(?) TRIGGER NAME instead_of database_event ON view_name trigger_action
 497     {
 498         my $table_name = $item[8]->{'name'};
 499         push @triggers, {
 500             name         => $item[4],
 501             is_temporary => $item[2][0] ? 1 : 0,
 502             when         => undef,
 503             instead_of   => 1,
 504             db_events    => [ $item[6] ],
 505             action       => $item[9],
 506             on_table     => $table_name,
 507         }
 508     }
 509
 510 database_event : /(delete|insert|update)/i
 511
 512 database_event : /update of/i column_list
 513
 514 trigger_action : for_each(?) when(?) BEGIN_C trigger_step(s) END_C
 515     {
 516         $return = {
 517             for_each => $item[1][0],
 518             when     => $item[2][0],
 519             steps    => $item[4],
 520         }
 521     }
 522
 523 for_each : /FOR EACH ROW/i
 524
 525 when : WHEN expr { $item[2] }
 526
 527 string :
 528    /'(\\.|''|[^\\\'])*'/
 529
 530 nonstring : /[^;\'"]+/
 531
 532 statement_body : string | nonstring
 533
 534 trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON
 535     {
 536         $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
 537     }
 538
 539 before_or_after : /(before|after)/i { $return = lc $1 }
 540
 541 instead_of : /instead of/i
 542
 543 if_exists : /if exists/i
 544
 545 view_name : qualified_name
 546
 547 trigger_name : qualified_name
 548
 549 #
 550 # Create View
 551 #
 552 create : CREATE TEMPORARY(?) VIEW view_name AS select_statement
 553     {
 554         push @views, {
 555             name         => $item[4]->{'name'},
 556             sql          => $item[6],
 557             is_temporary => $item[2][0] ? 1 : 0,
 558         }
 559     }
 560
 561 select_statement : SELECT /[^;]+/ SEMICOLON
 562     {
 563         $return = join( ' ', $item[1], $item[2] );
 564     }
 565
 566 #
 567 # Tokens
 568 #
 569 BEGIN_C : /begin/i
 570
 571 END_C : /end/i
 572
 573 TRANSACTION: /transaction/i
 574
 575 CREATE : /create/i
 576
 577 TEMPORARY : /temp(orary)?/i { 1 }
 578
 579 TABLE : /table/i
 580
 581 INDEX : /index/i
 582
 583 NOT_NULL : /not null/i
 584
 585 PRIMARY_KEY : /primary key/i
 586
 587 FOREIGN_KEY : /foreign key/i
 588
 589 CHECK_C : /check/i
 590
 591 DEFAULT : /default/i
 592
 593 TRIGGER : /trigger/i
 594
 595 VIEW : /view/i
 596
 597 SELECT : /select/i
 598
 599 ON : /on/i
 600
 601 AS : /as/i
 602
 603 WORD : /\w+/
 604
 605 WHEN : /when/i
 606
 607 REFERENCES : /references/i
 608
 609 CONSTRAINT : /constraint/i
 610
 611 AUTOINCREMENT : /autoincrement/i
 612
 613 UNIQUE : /unique/i { 1 }
 614
 615 SEMICOLON : ';'
 616
 617 NAME : /["']?(\w+)["']?/ { $return = $1 }
 618
 619 VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
 620     { $item[1] }
 621     | /'.*?'/
 622     {
 623         # remove leading/trailing quotes
 624         my $val = $item[1];
 625         $val    =~ s/^['"]|['"]$//g;
 626         $return = $val;
 627     }
 628     | /NULL/
 629     { 'NULL' }
 630     | /CURRENT_TIMESTAMP/i
 631     { 'CURRENT_TIMESTAMP' }
 632
 633 !;
 634
 635 # -------------------------------------------------------------------
 636 sub parse {
 637     my ( $translator, $data ) = @_;
 638     my $parser = Parse::RecDescent->new($GRAMMAR);
 639
 640     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 641     local $DEBUG       = $translator->debug;
 642
 643     unless (defined $parser) {
 644         return $translator->error("Error instantiating Parse::RecDescent ".
 645             "instance: Bad grammer");
 646     }
 647
 648     my $result = $parser->startrule($data);
 649     return $translator->error( "Parse failed." ) unless defined $result;
 650     warn Dumper( $result ) if $DEBUG;
 651
 652     my $schema = $translator->schema;
 653     my @tables =
 654         map   { $_->[1] }
 655         sort  { $a->[0] <=> $b->[0] }
 656         map   { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] }
 657         keys %{ $result->{'tables'} };
 658
 659     for my $table_name ( @tables ) {
 660         my $tdata =  $result->{'tables'}{ $table_name };
 661         my $table =  $schema->add_table(
 662             name  => $tdata->{'name'},
 663         ) or die $schema->error;
 664
 665         $table->comments( $tdata->{'comments'} );
 666
 667         for my $fdata ( @{ $tdata->{'fields'} } ) {
 668             my $field = $table->add_field(
 669                 name              => $fdata->{'name'},
 670                 data_type         => $fdata->{'data_type'},
 671                 size              => $fdata->{'size'},
 672                 default_value     => $fdata->{'default'},
 673                 is_auto_increment => $fdata->{'is_auto_inc'},
 674                 is_nullable       => $fdata->{'is_nullable'},
 675                 comments          => $fdata->{'comments'},
 676             ) or die $table->error;
 677
 678             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 679
 680             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 681                 next unless $cdata->{'type'} eq 'foreign_key';
 682                 $cdata->{'fields'} ||= [ $field->name ];
 683                 push @{ $tdata->{'constraints'} }, $cdata;
 684             }
 685         }
 686
 687         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 688             my $index  =  $table->add_index(
 689                 name   => $idata->{'name'},
 690                 type   => uc ($idata->{'type'}||''),
 691                 fields => $idata->{'fields'},
 692             ) or die $table->error;
 693         }
 694
 695         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 696             my $constraint       =  $table->add_constraint(
 697                 name             => $cdata->{'name'},
 698                 type             => $cdata->{'type'},
 699                 fields           => $cdata->{'fields'},
 700                 reference_table  => $cdata->{'reference_table'},
 701                 reference_fields => $cdata->{'reference_fields'},
 702                 match_type       => $cdata->{'match_type'} || '',
 703                 on_delete        => $cdata->{'on_delete'}
 704                                  || $cdata->{'on_delete_do'},
 705                 on_update        => $cdata->{'on_update'}
 706                                  || $cdata->{'on_update_do'},
 707             ) or die $table->error;
 708         }
 709     }
 710
 711     for my $def ( @{ $result->{'views'} || [] } ) {
 712         my $view = $schema->add_view(
 713             name => $def->{'name'},
 714             sql  => $def->{'sql'},
 715         );
 716     }
 717
 718     for my $def ( @{ $result->{'triggers'} || [] } ) {
 719         my $view                = $schema->add_trigger(
 720             name                => $def->{'name'},
 721             perform_action_when => $def->{'when'},
 722             database_events     => $def->{'db_events'},
 723             action              => $def->{'action'},
 724             on_table            => $def->{'on_table'},
 725         );
 726     }
 727
 728     return 1;
 729 }
 730
 731 1;
 732
 733 # -------------------------------------------------------------------
 734 # All wholsome food is caught without a net or a trap.
 735 # William Blake
 736 # -------------------------------------------------------------------
 737
 738 =pod
 739
 740 =head1 AUTHOR
 741
 742 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 743
 744 =head1 SEE ALSO
 745
 746 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 747
 748 =cut