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 TABLE <commit> table_name SEMICOLON
 202
 203 comment : /^\s*(?:#|-{2}).*\n/
 204     {
 205         my $comment =  $item[1];
 206         $comment    =~ s/^\s*(#|-{2})\s*//;
 207         $comment    =~ s/\s*$//;
 208         $return     = $comment;
 209     }
 210
 211 comment : /\/\*/ /[^\*]+/ /\*\//
 212     {
 213         my $comment = $item[2];
 214         $comment    =~ s/^\s*|\s*$//g;
 215         $return = $comment;
 216     }
 217
 218 #
 219 # Create Index
 220 #
 221 create : CREATE TEMPORARY(?) UNIQUE(?) INDEX WORD ON table_name parens_field_list conflict_clause(?) SEMICOLON
 222     {
 223         my $db_name    = $item[7]->{'db_name'} || '';
 224         my $table_name = $item[7]->{'name'};
 225
 226         my $index        =  {
 227             name         => $item[5],
 228             fields       => $item[8],
 229             on_conflict  => $item[9][0],
 230             is_temporary => $item[2][0] ? 1 : 0,
 231         };
 232
 233         my $is_unique = $item[3][0];
 234
 235         if ( $is_unique ) {
 236             $index->{'type'} = 'unique';
 237             push @{ $tables{ $table_name }{'constraints'} }, $index;
 238         }
 239         else {
 240             push @{ $tables{ $table_name }{'indices'} }, $index;
 241         }
 242     }
 243
 244 #
 245 # Create Table
 246 #
 247 create : CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLON
 248     {
 249         my $db_name    = $item[4]->{'db_name'} || '';
 250         my $table_name = $item[4]->{'name'};
 251
 252         $tables{ $table_name }{'name'}         = $table_name;
 253         $tables{ $table_name }{'is_temporary'} = $item[2][0] ? 1 : 0;
 254         $tables{ $table_name }{'order'}        = ++$table_order;
 255
 256         for my $def ( @{ $item[6] } ) {
 257             if ( $def->{'supertype'} eq 'column' ) {
 258                 push @{ $tables{ $table_name }{'fields'} }, $def;
 259             }
 260             elsif ( $def->{'supertype'} eq 'constraint' ) {
 261                 push @{ $tables{ $table_name }{'constraints'} }, $def;
 262             }
 263         }
 264     }
 265
 266 definition : constraint_def | column_def
 267
 268 column_def: NAME type(?) column_constraint(s?)
 269     {
 270         my $column = {
 271             supertype      => 'column',
 272             name           => $item[1],
 273             data_type      => $item[2][0]->{'type'},
 274             size           => $item[2][0]->{'size'},
 275             is_nullable    => 1,
 276             is_primary_key => 0,
 277             is_unique      => 0,
 278             check          => '',
 279             default        => undef,
 280             constraints    => $item[3],
 281         };
 282
 283         for my $c ( @{ $item[3] } ) {
 284             if ( $c->{'type'} eq 'not_null' ) {
 285                 $column->{'is_nullable'} = 0;
 286             }
 287             elsif ( $c->{'type'} eq 'primary_key' ) {
 288                 $column->{'is_primary_key'} = 1;
 289             }
 290             elsif ( $c->{'type'} eq 'unique' ) {
 291                 $column->{'is_unique'} = 1;
 292             }
 293             elsif ( $c->{'type'} eq 'check' ) {
 294                 $column->{'check'} = $c->{'expression'};
 295             }
 296             elsif ( $c->{'type'} eq 'default' ) {
 297                 $column->{'default'} = $c->{'value'};
 298             }
 299         }
 300
 301         $column;
 302     }
 303
 304 type : WORD parens_value_list(?)
 305     {
 306         $return = {
 307             type => $item[1],
 308             size => $item[2][0],
 309         }
 310     }
 311
 312 column_constraint : NOT_NULL conflict_clause(?)
 313     {
 314         $return = {
 315             type => 'not_null',
 316         }
 317     }
 318     |
 319     PRIMARY_KEY sort_order(?) conflict_clause(?)
 320     {
 321         $return = {
 322             type        => 'primary_key',
 323             sort_order  => $item[2][0],
 324             on_conflict => $item[2][0],
 325         }
 326     }
 327     |
 328     UNIQUE conflict_clause(?)
 329     {
 330         $return = {
 331             type        => 'unique',
 332             on_conflict => $item[2][0],
 333         }
 334     }
 335     |
 336     CHECK_C '(' expr ')' conflict_clause(?)
 337     {
 338         $return = {
 339             type        => 'check',
 340             expression  => $item[3],
 341             on_conflict => $item[5][0],
 342         }
 343     }
 344     |
 345     DEFAULT VALUE
 346     {
 347         $return   = {
 348             type  => 'default',
 349             value => $item[2],
 350         }
 351     }
 352
 353 constraint_def : PRIMARY_KEY parens_field_list conflict_clause(?)
 354     {
 355         $return         = {
 356             supertype   => 'constraint',
 357             type        => 'primary_key',
 358             fields      => $item[2],
 359             on_conflict => $item[3][0],
 360         }
 361     }
 362     |
 363     UNIQUE parens_field_list conflict_clause(?)
 364     {
 365         $return         = {
 366             supertype   => 'constraint',
 367             type        => 'unique',
 368             fields      => $item[2],
 369             on_conflict => $item[3][0],
 370         }
 371     }
 372     |
 373     CHECK_C '(' expr ')' conflict_clause(?)
 374     {
 375         $return         = {
 376             supertype   => 'constraint',
 377             type        => 'check',
 378             expression  => $item[3],
 379             on_conflict => $item[5][0],
 380         }
 381     }
 382
 383 table_name : qualified_name
 384
 385 qualified_name : NAME
 386     { $return = { name => $item[1] } }
 387
 388 qualified_name : /(\w+)\.(\w+)/
 389     { $return = { db_name => $1, name => $2 } }
 390
 391 field_name : NAME
 392
 393 conflict_clause : /on conflict/i conflict_algorigthm
 394
 395 conflict_algorigthm : /(rollback|abort|fail|ignore|replace)/i
 396
 397 parens_field_list : '(' column_list ')'
 398     { $item[2] }
 399
 400 column_list : field_name(s /,/)
 401
 402 parens_value_list : '(' VALUE(s /,/) ')'
 403     { $item[2] }
 404
 405 expr : /[^)]+/
 406
 407 sort_order : /(ASC|DESC)/i
 408
 409 #
 410 # Create Trigger
 411
 412 create : CREATE TEMPORARY(?) TRIGGER NAME before_or_after(?) database_event ON table_name trigger_action SEMICOLON
 413     {
 414         my $table_name = $item[8]->{'name'};
 415         push @triggers, {
 416             name         => $item[4],
 417             is_temporary => $item[2][0] ? 1 : 0,
 418             when         => $item[5][0],
 419             instead_of   => 0,
 420             db_events    => [ $item[6] ],
 421             action       => $item[9],
 422             on_table     => $table_name,
 423         }
 424     }
 425
 426 create : CREATE TEMPORARY(?) TRIGGER NAME instead_of database_event ON view_name trigger_action
 427     {
 428         my $table_name = $item[8]->{'name'};
 429         push @triggers, {
 430             name         => $item[4],
 431             is_temporary => $item[2][0] ? 1 : 0,
 432             when         => undef,
 433             instead_of   => 1,
 434             db_events    => [ $item[6] ],
 435             action       => $item[9],
 436             on_table     => $table_name,
 437         }
 438     }
 439
 440 database_event : /(delete|insert|update)/i
 441
 442 database_event : /update of/i column_list
 443
 444 trigger_action : for_each(?) when(?) BEGIN_C trigger_step(s) END_C
 445     {
 446         $return = {
 447             for_each => $item[1][0],
 448             when     => $item[2][0],
 449             steps    => $item[4],
 450         }
 451     }
 452
 453 for_each : /FOR EACH ROW/i
 454
 455 when : WHEN expr { $item[2] }
 456
 457 string :
 458    /'(\\.|''|[^\\\'])*'/
 459
 460 nonstring : /[^;\'"]+/
 461
 462 statement_body : (string | nonstring)(s?)
 463
 464 trigger_step : /(select|delete|insert|update)/i statement_body SEMICOLON
 465     {
 466         $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } )
 467     }
 468
 469 before_or_after : /(before|after)/i { $return = lc $1 }
 470
 471 instead_of : /instead of/i
 472
 473 view_name : qualified_name
 474
 475 #
 476 # Create View
 477 #
 478 create : CREATE TEMPORARY(?) VIEW view_name AS select_statement
 479     {
 480         push @views, {
 481             name         => $item[4]->{'name'},
 482             sql          => $item[6],
 483             is_temporary => $item[2][0] ? 1 : 0,
 484         }
 485     }
 486
 487 select_statement : SELECT /[^;]+/ SEMICOLON
 488     {
 489         $return = join( ' ', $item[1], $item[2] );
 490     }
 491
 492 #
 493 # Tokens
 494 #
 495 BEGIN_C : /begin/i
 496
 497 END_C : /end/i
 498
 499 TRANSACTION: /transaction/i
 500
 501 CREATE : /create/i
 502
 503 TEMPORARY : /temp(orary)?/i { 1 }
 504
 505 TABLE : /table/i
 506
 507 INDEX : /index/i
 508
 509 NOT_NULL : /not null/i
 510
 511 PRIMARY_KEY : /primary key/i
 512
 513 CHECK_C : /check/i
 514
 515 DEFAULT : /default/i
 516
 517 TRIGGER : /trigger/i
 518
 519 VIEW : /view/i
 520
 521 SELECT : /select/i
 522
 523 ON : /on/i
 524
 525 AS : /as/i
 526
 527 WORD : /\w+/
 528
 529 WHEN : /when/i
 530
 531 UNIQUE : /unique/i { 1 }
 532
 533 SEMICOLON : ';'
 534
 535 NAME : /'?(\w+)'?/ { $return = $1 }
 536
 537 VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
 538     { $item[1] }
 539     | /'.*?'/
 540     {
 541         # remove leading/trailing quotes
 542         my $val = $item[1];
 543         $val    =~ s/^['"]|['"]$//g;
 544         $return = $val;
 545     }
 546     | /NULL/
 547     { 'NULL' }
 548     | /CURRENT_TIMESTAMP/i
 549     { 'CURRENT_TIMESTAMP' }
 550
 551 !;
 552
 553 # -------------------------------------------------------------------
 554 sub parse {
 555     my ( $translator, $data ) = @_;
 556     my $parser = Parse::RecDescent->new($GRAMMAR);
 557
 558     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 559     local $DEBUG       = $translator->debug;
 560
 561     unless (defined $parser) {
 562         return $translator->error("Error instantiating Parse::RecDescent ".
 563             "instance: Bad grammer");
 564     }
 565
 566     my $result = $parser->startrule($data);
 567     return $translator->error( "Parse failed." ) unless defined $result;
 568     warn Dumper( $result ) if $DEBUG;
 569
 570     my $schema = $translator->schema;
 571     my @tables =
 572         map   { $_->[1] }
 573         sort  { $a->[0] <=> $b->[0] }
 574         map   { [ $result->{'tables'}{ $_ }->{'order'}, $_ ] }
 575         keys %{ $result->{'tables'} };
 576
 577     for my $table_name ( @tables ) {
 578         my $tdata =  $result->{'tables'}{ $table_name };
 579         my $table =  $schema->add_table(
 580             name  => $tdata->{'name'},
 581         ) or die $schema->error;
 582
 583         $table->comments( $tdata->{'comments'} );
 584
 585         for my $fdata ( @{ $tdata->{'fields'} } ) {
 586             my $field = $table->add_field(
 587                 name              => $fdata->{'name'},
 588                 data_type         => $fdata->{'data_type'},
 589                 size              => $fdata->{'size'},
 590                 default_value     => $fdata->{'default'},
 591                 is_auto_increment => $fdata->{'is_auto_inc'},
 592                 is_nullable       => $fdata->{'is_nullable'},
 593                 comments          => $fdata->{'comments'},
 594             ) or die $table->error;
 595
 596             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 597
 598             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 599                 next unless $cdata->{'type'} eq 'foreign_key';
 600                 $cdata->{'fields'} ||= [ $field->name ];
 601                 push @{ $tdata->{'constraints'} }, $cdata;
 602             }
 603         }
 604
 605         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 606             my $index  =  $table->add_index(
 607                 name   => $idata->{'name'},
 608                 type   => uc $idata->{'type'},
 609                 fields => $idata->{'fields'},
 610             ) or die $table->error;
 611         }
 612
 613         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 614             my $constraint       =  $table->add_constraint(
 615                 name             => $cdata->{'name'},
 616                 type             => $cdata->{'type'},
 617                 fields           => $cdata->{'fields'},
 618                 reference_table  => $cdata->{'reference_table'},
 619                 reference_fields => $cdata->{'reference_fields'},
 620                 match_type       => $cdata->{'match_type'} || '',
 621                 on_delete        => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
 622                 on_update        => $cdata->{'on_update'} || $cdata->{'on_update_do'},
 623             ) or die $table->error;
 624         }
 625     }
 626
 627     for my $def ( @{ $result->{'views'} || [] } ) {
 628         my $view = $schema->add_view(
 629             name => $def->{'name'},
 630             sql  => $def->{'sql'},
 631         );
 632     }
 633
 634     for my $def ( @{ $result->{'triggers'} || [] } ) {
 635         my $view                = $schema->add_trigger(
 636             name                => $def->{'name'},
 637             perform_action_when => $def->{'when'},
 638             database_events     => $def->{'db_events'},
 639             action              => $def->{'action'},
 640             on_table            => $def->{'on_table'},
 641         );
 642     }
 643
 644     return 1;
 645 }
 646
 647 1;
 648
 649 # -------------------------------------------------------------------
 650 # All wholsome food is caught without a net or a trap.
 651 # William Blake
 652 # -------------------------------------------------------------------
 653
 654 =pod
 655
 656 =head1 AUTHOR
 657
 658 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 659
 660 =head1 SEE ALSO
 661
 662 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 663
 664 =cut