lib/SQL/Translator/Parser/PostgreSQL.pm

   1 package SQL::Translator::Parser::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.11 2003-04-17 19:42:33 allenday Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
   7 #                    Allen Day <allenday@users.sourceforge.net>,
   8 #                    darren chamberlain <darren@cpan.org>,
   9 #                    Chris Mungall <cjm@fruitfly.org>
  10 #
  11 # This program is free software; you can redistribute it and/or
  12 # modify it under the terms of the GNU General Public License as
  13 # published by the Free Software Foundation; version 2.
  14 #
  15 # This program is distributed in the hope that it will be useful, but
  16 # WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 # General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program; if not, write to the Free Software
  22 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  23 # 02111-1307  USA
  24 # -------------------------------------------------------------------
  25
  26 =head1 NAME
  27
  28 SQL::Translator::Parser::PostgreSQL - parser for PostgreSQL
  29
  30 =head1 SYNOPSIS
  31
  32   use SQL::Translator;
  33   use SQL::Translator::Parser::PostgreSQL;
  34
  35   my $translator = SQL::Translator->new;
  36   $translator->parser("SQL::Translator::Parser::PostgreSQL");
  37
  38 =head1 DESCRIPTION
  39
  40 The grammar was started from the MySQL parsers.  Here is the description
  41 from PostgreSQL:
  42
  43 Table:
  44 (http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createtable.html)
  45
  46   CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
  47       { column_name data_type [ DEFAULT default_expr ]
  48          [ column_constraint [, ... ] ]
  49       | table_constraint }  [, ... ]
  50   )
  51   [ INHERITS ( parent_table [, ... ] ) ]
  52   [ WITH OIDS | WITHOUT OIDS ]
  53
  54   where column_constraint is:
  55
  56   [ CONSTRAINT constraint_name ]
  57   { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
  58     CHECK (expression) |
  59     REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
  60       [ ON DELETE action ] [ ON UPDATE action ] }
  61   [ DEFERRABLE | NOT DEFERRABLE ]
  62   [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
  63
  64   and table_constraint is:
  65
  66   [ CONSTRAINT constraint_name ]
  67   { UNIQUE ( column_name [, ... ] ) |
  68     PRIMARY KEY ( column_name [, ... ] ) |
  69     CHECK ( expression ) |
  70     FOREIGN KEY ( column_name [, ... ] )
  71      REFERENCES reftable [ ( refcolumn [, ... ] ) ]
  72       [ MATCH FULL | MATCH PARTIAL ]
  73       [ ON DELETE action ] [ ON UPDATE action ] }
  74   [ DEFERRABLE | NOT DEFERRABLE ]
  75   [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
  76
  77 Index:
  78 (http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createindex.html)
  79
  80   CREATE [ UNIQUE ] INDEX index_name ON table
  81       [ USING acc_method ] ( column [ ops_name ] [, ...] )
  82       [ WHERE predicate ]
  83   CREATE [ UNIQUE ] INDEX index_name ON table
  84       [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
  85       [ WHERE predicate ]
  86
  87 Alter table:
  88
  89   ALTER TABLE [ ONLY ] table [ * ]
  90       ADD [ COLUMN ] column type [ column_constraint [ ... ] ]
  91   ALTER TABLE [ ONLY ] table [ * ]
  92       ALTER [ COLUMN ] column { SET DEFAULT value | DROP DEFAULT }
  93   ALTER TABLE [ ONLY ] table [ * ]
  94       ALTER [ COLUMN ] column SET STATISTICS integer
  95   ALTER TABLE [ ONLY ] table [ * ]
  96       RENAME [ COLUMN ] column TO newcolumn
  97   ALTER TABLE table
  98       RENAME TO new_table
  99   ALTER TABLE table
 100       ADD table_constraint_definition
 101   ALTER TABLE [ ONLY ] table
 102           DROP CONSTRAINT constraint { RESTRICT | CASCADE }
 103   ALTER TABLE table
 104           OWNER TO new_owner
 105
 106 =cut
 107
 108 use strict;
 109 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
 110 $VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/;
 111 $DEBUG   = 0 unless defined $DEBUG;
 112
 113 use Data::Dumper;
 114 use Parse::RecDescent;
 115 use Exporter;
 116 use base qw(Exporter);
 117
 118 @EXPORT_OK = qw(parse);
 119
 120 # Enable warnings within the Parse::RecDescent module.
 121 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
 122 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
 123 $::RD_HINT   = 1; # Give out hints to help fix problems.
 124
 125 my $parser; # should we do this?  There's no programmic way to
 126             # change the grammar, so I think this is safe.
 127
 128 $GRAMMAR = q!
 129
 130 { our ( %tables, $table_order ) }
 131
 132 #
 133 # The "eofile" rule makes the parser fail if any "statement" rule
 134 # fails.  Otherwise, the first successful match by a "statement"
 135 # won't cause the failure needed to know that the parse, as a whole,
 136 # failed. -ky
 137 #
 138 startrule : statement(s) eofile { \%tables }
 139
 140 eofile : /^\Z/
 141
 142 statement : create
 143   | comment
 144   | alter
 145   | grant
 146   | revoke
 147   | drop
 148   | connect
 149   | set
 150   | <error>
 151
 152 connect : /^\s*\\\connect.*\n/
 153
 154 set : /SET/ /[^;]*/ ';'
 155
 156 revoke : /revoke/i WORD(s /,/) /on/i table_name /from/i name_with_opt_quotes(s /,/) ';'
 157     {
 158         my $table_name = $item{'table_name'};
 159         push @{ $tables{ $table_name }{'permissions'} }, {
 160             type       => 'revoke',
 161             actions    => $item[2],
 162             users      => $item[6],
 163         }
 164     }
 165
 166 grant : /grant/i WORD(s /,/) /on/i table_name /to/i name_with_opt_quotes(s /,/) ';'
 167     {
 168         my $table_name = $item{'table_name'};
 169         push @{ $tables{ $table_name }{'permissions'} }, {
 170             type       => 'grant',
 171             actions    => $item[2],
 172             users      => $item[6],
 173         }
 174     }
 175
 176 drop : /drop/i /[^;]*/ ';'
 177
 178 #
 179 # Create table.
 180 #
 181 create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
 182     {
 183         my $table_name                       = $item{'table_name'};
 184         $tables{ $table_name }{'order'}      = ++$table_order;
 185         $tables{ $table_name }{'table_name'} = $table_name;
 186
 187         my $i = 1;
 188         my @constraints;
 189         for my $definition ( @{ $item[4] } ) {
 190             if ( $definition->{'type'} eq 'field' ) {
 191                 my $field_name = $definition->{'name'};
 192                 $tables{ $table_name }{'fields'}{ $field_name } =
 193                     { %$definition, order => $i };
 194                 $i++;
 195
 196                 if ( $definition->{'is_primary_key'} ) {
 197                     push @{ $tables{ $table_name }{'indices'} }, {
 198                         type   => 'primary_key',
 199                         fields => [ $field_name ],
 200                     };
 201                 }
 202
 203                 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
 204                     $constraint->{'fields'} = [ $field_name ];
 205                     push @{ $tables{ $table_name }{'constraints'} },
 206                         $constraint;
 207                 }
 208             }
 209             elsif ( $definition->{'type'} eq 'constraint' ) {
 210                 $definition->{'type'} = $definition->{'constraint_type'};
 211                 # group FKs at the field level
 212                 if ( $definition->{'type'} eq 'foreign_key' ) {
 213                     for my $fld ( @{ $definition->{'fields'} || [] } ) {
 214                         push @{
 215                             $tables{$table_name}{'fields'}{$fld}{'constraints'}
 216                         }, $definition;
 217                     }
 218                 }
 219                 else {
 220                     push @{ $tables{ $table_name }{'constraints'} },
 221                         $definition;
 222                 }
 223             }
 224             else {
 225                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 226             }
 227         }
 228
 229         for my $option ( @{ $item[6] } ) {
 230             $tables{ $table_name }{'table_options'}{ $option->{'type'} } =
 231                 $option;
 232         }
 233
 234         1;
 235     }
 236
 237 #
 238 # Create index.
 239 #
 240 create : /create/i unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
 241     {
 242         push @{ $tables{ $item{'table_name'} }{'indices'} },
 243             {
 244                 name   => $item{'index_name'},
 245                 type   => $item{'unique'}[0] ? 'unique' : 'normal',
 246                 fields => $item[9],
 247                 method => $item{'using_method'}[0],
 248             }
 249         ;
 250     }
 251
 252 #
 253 # Create anything else (e.g., domain, function, etc.)
 254 #
 255 create : /create/i WORD /[^;]+/ ';'
 256
 257 using_method : /using/i WORD { $item[2] }
 258
 259 where_predicate : /where/i /[^;]+/
 260
 261 create_definition : field
 262     | table_constraint
 263     | <error>
 264
 265 comment : /^\s*(?:#|-{2}).*\n/
 266
 267 field : comment(s?) field_name data_type field_meta(s?) comment(s?)
 268     {
 269         my ( $default, @constraints );
 270         for my $meta ( @{ $item[4] } ) {
 271             $default = $meta if $meta->{'meta_type'} eq 'default';
 272             push @constraints, $meta if $meta->{'meta_type'} eq 'constraint';
 273         }
 274
 275         my $null = ( grep { $_->{'type'} eq 'not_null' } @constraints ) ? 0 : 1;
 276
 277         my @comments = ( @{ $item[1] }, @{ $item[5] } );
 278
 279         $return = {
 280             type           => 'field',
 281             name           => $item{'field_name'},
 282             data_type      => $item{'data_type'}{'type'},
 283             size           => $item{'data_type'}{'size'},
 284             list           => $item{'data_type'}{'list'},
 285             null           => $null,
 286             default        => $default->{'value'},
 287             constraints    => [ @constraints ],
 288             comments       => [ @comments ],
 289         }
 290     }
 291     | <error>
 292
 293 field_meta : default_val
 294     |
 295     column_constraint
 296
 297 column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
 298     {
 299         my $desc       = $item{'column_constraint_type'};
 300         my $type       = $desc->{'type'};
 301         my $fields     = $desc->{'fields'}     || [];
 302         my $expression = $desc->{'expression'} || '';
 303
 304         $return              =  {
 305             meta_type        => 'constraint',
 306             name             => $item{'constraint_name'}[0] || '',
 307             type             => $type,
 308             expression       => $type eq 'check' ? $expression : '',
 309             deferreable      => $item{'deferrable'},
 310             deferred         => $item{'deferred'},
 311             reference_table  => $desc->{'reference_table'},
 312             reference_fields => $desc->{'reference_fields'},
 313             match_type       => $desc->{'match_type'},
 314             on_delete_do     => $desc->{'on_delete_do'},
 315             on_update_do     => $desc->{'on_update_do'},
 316         }
 317     }
 318
 319 constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
 320
 321 column_constraint_type : /not null/i { $return = { type => 'not_null' } }
 322     |
 323     /null/
 324         { $return = { type => 'null' } }
 325     |
 326     /unique/
 327         { $return = { type => 'unique' } }
 328     |
 329     /primary key/i
 330         { $return = { type => 'primary_key' } }
 331     |
 332     /check/i '(' /[^)]+/ ')'
 333         { $return = { type => 'check', expression => $item[2] } }
 334     |
 335     /references/i table_name parens_word_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 336     {
 337         $return              =  {
 338             type             => 'foreign_key',
 339             reference_table  => $item[2],
 340             reference_fields => $item[3][0],
 341             match_type       => $item[4][0],
 342             on_delete_do     => $item[5][0],
 343             on_update_do     => $item[6][0],
 344         }
 345     }
 346
 347 table_name : name_with_opt_quotes
 348
 349 field_name : name_with_opt_quotes
 350
 351 name_with_opt_quotes : double_quote(?) NAME double_quote(?) { $item[2] }
 352
 353 double_quote: /"/
 354
 355 index_name : WORD
 356
 357 data_type : pg_data_type parens_value_list(?)
 358     {
 359         my $type = $item[1];
 360
 361         #
 362         # We can deduce some sizes from the data type's name.
 363         #
 364         my $size;
 365         if ( ref $type eq 'ARRAY' ) {
 366             $size = [ $type->[1] ];
 367             $type = $type->[0];
 368         }
 369         else {
 370             $size = $item[2][0] || '';
 371         }
 372
 373         $return  = {
 374             type => $type,
 375             size => $size,
 376         }
 377     }
 378
 379 pg_data_type :
 380     /(bigint|int8|bigserial|serial8)/ { $return = [ 'integer(8) auto_increment'] }
 381     |
 382     /(smallint|int2)/ { $return = [ 'integer', 2 ] }
 383     |
 384     /int(eger)?|int4/ { $return = [ 'integer', 4 ] }
 385     |
 386     /(double precision|float8?)/ { $return = [ 'float', 8 ] }
 387     |
 388     /(real|float4)/ { $return = [ 'real', 4 ] }
 389     |
 390     /serial4?/ { $return = [ 'integer(4) auto_increment'] }
 391     |
 392     /bigserial/ { $return = [ 'integer(8) auto_increment'] }
 393     |
 394     /(bit varying|varbit)/ { $return = 'varbit' }
 395     |
 396     /character varying/ { $return = 'varchar' }
 397     |
 398     /char(acter)?/ { $return = 'char' }
 399     |
 400     /bool(ean)?/ { $return = 'boolean' }
 401     |
 402     /(bytea|binary data)/ { $return = 'binary' }
 403     |
 404     /timestampz?/ { $return = 'timestamp' }
 405     |
 406     /(bit|box|cidr|circle|date|inet|interval|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|text|time|varchar)/
 407     { $item[1] }
 408
 409 parens_value_list : '(' VALUE(s /,/) ')'
 410     { $item[2] }
 411
 412 parens_word_list : '(' WORD(s /,/) ')'
 413     { $item[2] }
 414
 415 field_size : '(' num_range ')' { $item{'num_range'} }
 416
 417 num_range : DIGITS ',' DIGITS
 418     { $return = $item[1].','.$item[3] }
 419     | DIGITS
 420     { $return = $item[1] }
 421
 422 table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
 423     {
 424         my $desc       = $item{'table_constraint_type'};
 425         my $type       = $desc->{'type'};
 426         my $fields     = $desc->{'fields'};
 427         my $expression = $desc->{'expression'};
 428         my @comments   = ( @{ $item[1] }, @{ $item[-1] } );
 429
 430         $return              =  {
 431             name             => $item{'constraint_name'}[0] || '',
 432             type             => 'constraint',
 433             constraint_type  => $type,
 434             fields           => $type ne 'check' ? $fields : [],
 435             expression       => $type eq 'check' ? $expression : '',
 436             deferreable      => $item{'deferrable'},
 437             deferred         => $item{'deferred'},
 438             reference_table  => $desc->{'reference_table'},
 439             reference_fields => $desc->{'reference_fields'},
 440             match_type       => $desc->{'match_type'}[0],
 441             on_delete_do     => $desc->{'on_delete_do'},
 442             on_update_do     => $desc->{'on_update_do'},
 443             comments         => [ @comments ],
 444         }
 445     }
 446
 447 table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')'
 448     {
 449         $return = {
 450             type   => 'primary_key',
 451             fields => $item[3],
 452         }
 453     }
 454     |
 455     /unique/i '(' name_with_opt_quotes(s /,/) ')'
 456     {
 457         $return    =  {
 458             type   => 'unique',
 459             fields => $item[3],
 460         }
 461     }
 462     |
 463     /check/ '(' /(.+)/ ')'
 464     {
 465         $return        =  {
 466             type       => 'check',
 467             expression => $item[3],
 468         }
 469     }
 470     |
 471     /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 472     {
 473         $return              =  {
 474             type             => 'foreign_key',
 475             fields           => $item[3],
 476             reference_table  => $item[6],
 477             reference_fields => $item[7][0],
 478             match_type       => $item[8][0],
 479             on_delete_do     => $item[9][0],
 480             on_update_do     => $item[10][0],
 481         }
 482     }
 483
 484 deferrable : /not/i /deferrable/i
 485     {
 486         $return = ( $item[1] =~ /not/i ) ? 0 : 1;
 487     }
 488
 489 deferred : /initially/i /(deferred|immediate)/i { $item[2] }
 490
 491 match_type : /match full/i { 'match_full' }
 492     |
 493     /match partial/i { 'match_partial' }
 494
 495 on_delete_do : /on delete/i WORD(s)
 496     { $item[2] }
 497
 498 on_update_do : /on update/i WORD(s)
 499     { $item[2] }
 500
 501 alter : alter_table table_name /add/i table_constraint ';'
 502     {
 503         my $table_name = $item[2];
 504         my $constraint = $item[4];
 505         $constraint->{'type'} = $constraint->{'constraint_type'};
 506         push @{ $tables{ $table_name }{'constraints'} }, $constraint;
 507     }
 508
 509 alter_table : /alter/i /table/i only(?)
 510
 511 only : /only/i
 512
 513 create_table : /create/i /table/i
 514
 515 create_index : /create/i /index/i
 516
 517 default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/
 518     {
 519         my $val =  $item[2] || '';
 520         $val    =~ s/'//g;
 521         $return =  {
 522             meta_type => 'default',
 523             value     => $val,
 524         }
 525     }
 526
 527 name_with_opt_paren : NAME parens_value_list(s?)
 528     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 529
 530 unique : /unique/i { 1 }
 531
 532 key : /key/i | /index/i
 533
 534 table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
 535     {
 536         $return = { type => 'inherits', table_name => $item[3] }
 537     }
 538     |
 539     /with(out)? oids/i
 540     {
 541         $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
 542     }
 543
 544 SEMICOLON : /\s*;\n?/
 545
 546 WORD : /\w+/
 547
 548 DIGITS : /\d+/
 549
 550 COMMA : ','
 551
 552 NAME    : "`" /\w+/ "`"
 553     { $item[2] }
 554     | /\w+/
 555     { $item[1] }
 556     | /[\$\w]+/
 557     { $item[1] }
 558
 559 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 560     { $item[1] }
 561     | /'.*?'/   # XXX doesn't handle embedded quotes
 562     { $item[1] }
 563     | /NULL/
 564     { 'NULL' }
 565
 566 !;
 567
 568 # -------------------------------------------------------------------
 569 sub parse {
 570     my ( $translator, $data ) = @_;
 571     $parser ||= Parse::RecDescent->new($GRAMMAR);
 572
 573     $::RD_TRACE  = $translator->trace ? 1 : undef;
 574     $DEBUG       = $translator->debug;
 575
 576     unless (defined $parser) {
 577         return $translator->error("Error instantiating Parse::RecDescent ".
 578             "instance: Bad grammer");
 579     }
 580
 581     my $result = $parser->startrule($data);
 582     die "Parse failed.\n" unless defined $result;
 583     warn Dumper($result) if $DEBUG;
 584     return $result;
 585 }
 586
 587 1;
 588
 589 #-----------------------------------------------------
 590 # Where man is not nature is barren.
 591 # William Blake
 592 #-----------------------------------------------------
 593
 594 =pod
 595
 596 =head1 AUTHORS
 597
 598 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 599 Allen Day <allenday@ucla.edu>.
 600
 601 =head1 SEE ALSO
 602
 603 perl(1), Parse::RecDescent.
 604
 605 =cut