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 ref_def : /(\w+)\s*\((\w+)\)/
 438     { $return = { reference_table => $1, reference_fields => $2 } }
 439
 440 table_name : qualified_name
 441
 442 qualified_name : NAME
 443     { $return = { name => $item[1] } }
 444
 445 qualified_name : /(\w+)\.(\w+)/
 446     { $return = { db_name => $1, name => $2 } }
 447
 448 field_name : NAME
 449
 450 constraint_name : NAME
 451
 452 conflict_clause : /on conflict/i conflict_algorigthm
 453
 454 conflict_algorigthm : /(rollback|abort|fail|ignore|replace)/i
 455
 456 parens_field_list : '(' column_list ')'
 457     { $item[2] }
 458
 459 column_list : field_name(s /,/)
 460
 461 parens_value_list : '(' VALUE(s /,/) ')'
 462     { $item[2] }
 463
 464 expr : /[^)]+/
 465
 466 sort_order : /(ASC|DESC)/i
 467
 468 #
 469 # Create Trigger
 470
 471 create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action SEMICOLON
 472     {
 473         my $table_name = $item[8]->{'name'};
 474         push @triggers, {
 475             name         => $item[4],
 476             is_temporary => $item[2][0] ? 1 : 0,
 477             when         => $item[5][0],
 478             instead_of   => 0,
 479             db_events    => [ $item[6] ],
 480             action       => $item[9],
 481             on_table     => $table_name,
 482         }
 483     }
 484
 485 create : CREATE TEMPORARY(?) TRIGGER NAME instead_of database_event ON view_name trigger_action
 486     {
 487         my $table_name = $item[8]->{'name'};
 488         push @triggers, {
 489             name         => $item[4],
 490             is_temporary => $item[2][0] ? 1 : 0,
 491             when         => undef,
 492             instead_of   => 1,
 493             db_events    => [ $item[6] ],
 494             action       => $item[9],
 495             on_table     => $table_name,
 496         }
 497     }
 498
 499 database_event : /(delete|insert|update)/i
 500
 501 database_event : /update of/i column_list
 502
 503 trigger_action : for_each(?) when(?) BEGIN_C trigger_step(s) END_C
 504     {
 505         $return = {
 506             for_each => $item[1][0],
 507             when     => $item[2][0],
 508             steps    => $item[4],
 509         }
 510     }
 511
 512 for_each : /FOR EACH ROW/i
 513
 514 when : WHEN expr { $item[2] }
 515
 516 string :
 517    /'(\\.|''|[^\\\'])*'/
 518
 519 nonstring : /[^;\'"]+/
 520
 521 statement_body : string | nonstring
 522
 523 trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON
 524     {
 525         $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
 526     }
 527
 528 before_or_after : /(before|after)/i { $return = lc $1 }
 529
 530 instead_of : /instead of/i
 531
 532 if_exists : /if exists/i
 533
 534 view_name : qualified_name
 535
 536 trigger_name : qualified_name
 537
 538 #
 539 # Create View
 540 #
 541 create : CREATE TEMPORARY(?) VIEW view_name AS select_statement
 542     {
 543         push @views, {
 544             name         => $item[4]->{'name'},
 545             sql          => $item[6],
 546             is_temporary => $item[2][0] ? 1 : 0,
 547         }
 548     }
 549
 550 select_statement : SELECT /[^;]+/ SEMICOLON
 551     {
 552         $return = join( ' ', $item[1], $item[2] );
 553     }
 554
 555 #
 556 # Tokens
 557 #
 558 BEGIN_C : /begin/i
 559
 560 END_C : /end/i
 561
 562 TRANSACTION: /transaction/i
 563
 564 CREATE : /create/i
 565
 566 TEMPORARY : /temp(orary)?/i { 1 }
 567
 568 TABLE : /table/i
 569
 570 INDEX : /index/i
 571
 572 NOT_NULL : /not null/i
 573
 574 PRIMARY_KEY : /primary key/i
 575
 576 CHECK_C : /check/i
 577
 578 DEFAULT : /default/i
 579
 580 TRIGGER : /trigger/i
 581
 582 VIEW : /view/i
 583
 584 SELECT : /select/i
 585
 586 ON : /on/i
 587
 588 AS : /as/i
 589
 590 WORD : /\w+/
 591
 592 WHEN : /when/i
 593
 594 REFERENCES : /references/i
 595
 596 CONSTRAINT : /constraint/i
 597
 598 AUTOINCREMENT : /autoincrement/i
 599
 600 UNIQUE : /unique/i { 1 }
 601
 602 SEMICOLON : ';'
 603
 604 NAME : /["']?(\w+)["']?/ { $return = $1 }
 605
 606 VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
 607     { $item[1] }
 608     | /'.*?'/
 609     {
 610         # remove leading/trailing quotes
 611         my $val = $item[1];
 612         $val    =~ s/^['"]|['"]$//g;
 613         $return = $val;
 614     }
 615     | /NULL/
 616     { 'NULL' }
 617     | /CURRENT_TIMESTAMP/i
 618     { 'CURRENT_TIMESTAMP' }
 619
 620 !;
 621
 622 # -------------------------------------------------------------------
 623 sub parse {
 624     my ( $translator, $data ) = @_;
 625     my $parser = Parse::RecDescent->new($GRAMMAR);
 626
 627     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 628     local $DEBUG       = $translator->debug;
 629
 630     unless (defined $parser) {
 631         return $translator->error("Error instantiating Parse::RecDescent ".
 632             "instance: Bad grammer");
 633     }
 634
 635     my $result = $parser->startrule($data);
 636     return $translator->error( "Parse failed." ) unless defined $result;
 637     warn Dumper( $result ) if $DEBUG;
 638
 639     my $schema = $translator->schema;
 640     my @tables =
 641         map   { $_->[1] }
 642         sort  { $a->[0] <=> $b->[0] }
 643         map   { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] }
 644         keys %{ $result->{'tables'} };
 645
 646     for my $table_name ( @tables ) {
 647         my $tdata =  $result->{'tables'}{ $table_name };
 648         my $table =  $schema->add_table(
 649             name  => $tdata->{'name'},
 650         ) or die $schema->error;
 651
 652         $table->comments( $tdata->{'comments'} );
 653
 654         for my $fdata ( @{ $tdata->{'fields'} } ) {
 655             my $field = $table->add_field(
 656                 name              => $fdata->{'name'},
 657                 data_type         => $fdata->{'data_type'},
 658                 size              => $fdata->{'size'},
 659                 default_value     => $fdata->{'default'},
 660                 is_auto_increment => $fdata->{'is_auto_inc'},
 661                 is_nullable       => $fdata->{'is_nullable'},
 662                 comments          => $fdata->{'comments'},
 663             ) or die $table->error;
 664
 665             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 666
 667             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 668                 next unless $cdata->{'type'} eq 'foreign_key';
 669                 $cdata->{'fields'} ||= [ $field->name ];
 670                 push @{ $tdata->{'constraints'} }, $cdata;
 671             }
 672         }
 673
 674         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 675             my $index  =  $table->add_index(
 676                 name   => $idata->{'name'},
 677                 type   => uc ($idata->{'type'}||''),
 678                 fields => $idata->{'fields'},
 679             ) or die $table->error;
 680         }
 681
 682         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 683             my $constraint       =  $table->add_constraint(
 684                 name             => $cdata->{'name'},
 685                 type             => $cdata->{'type'},
 686                 fields           => $cdata->{'fields'},
 687                 reference_table  => $cdata->{'reference_table'},
 688                 reference_fields => $cdata->{'reference_fields'},
 689                 match_type       => $cdata->{'match_type'} || '',
 690                 on_delete        => $cdata->{'on_delete'}
 691                                  || $cdata->{'on_delete_do'},
 692                 on_update        => $cdata->{'on_update'}
 693                                  || $cdata->{'on_update_do'},
 694             ) or die $table->error;
 695         }
 696     }
 697
 698     for my $def ( @{ $result->{'views'} || [] } ) {
 699         my $view = $schema->add_view(
 700             name => $def->{'name'},
 701             sql  => $def->{'sql'},
 702         );
 703     }
 704
 705     for my $def ( @{ $result->{'triggers'} || [] } ) {
 706         my $view                = $schema->add_trigger(
 707             name                => $def->{'name'},
 708             perform_action_when => $def->{'when'},
 709             database_events     => $def->{'db_events'},
 710             action              => $def->{'action'},
 711             on_table            => $def->{'on_table'},
 712         );
 713     }
 714
 715     return 1;
 716 }
 717
 718 1;
 719
 720 # -------------------------------------------------------------------
 721 # All wholsome food is caught without a net or a trap.
 722 # William Blake
 723 # -------------------------------------------------------------------
 724
 725 =pod
 726
 727 =head1 AUTHOR
 728
 729 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 730
 731 =head1 SEE ALSO
 732
 733 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 734
 735 =cut