lib/SQL/Translator/Parser/PostgreSQL.pm

   1 package SQL::Translator::Parser::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.9 2003-02-26 05:17:21 kycl4rk 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.9 $ =~ /(\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->{'constaints'} || [] } ) {
 204                     $constraint->{'fields' } = [ $field_name ];
 205                     push @{$tables{ $table_name }{'constraints'}}, $constraint;
 206                 }
 207             }
 208             elsif ( $definition->{'type'} eq 'constraint' ) {
 209                 $definition->{'type'} = $definition->{'constraint_type'};
 210                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 211             }
 212             else {
 213                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 214             }
 215         }
 216
 217         for my $option ( @{ $item[6] } ) {
 218             $tables{ $table_name }{'table_options'}{ $option->{'type'} } =
 219                 $option;
 220         }
 221
 222         1;
 223     }
 224
 225 #
 226 # Create index.
 227 #
 228 create : /create/i unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
 229     {
 230         push @{ $tables{ $item{'table_name'} }{'indices'} },
 231             {
 232                 name   => $item{'index_name'},
 233                 type   => $item{'unique'}[0] ? 'unique' : 'normal',
 234                 fields => $item[9],
 235                 method => $item{'using_method'}[0],
 236             }
 237         ;
 238     }
 239
 240 #
 241 # Create anything else (e.g., domain, function, etc.)
 242 #
 243 create : /create/i WORD /[^;]+/ ';'
 244
 245 using_method : /using/i WORD { $item[2] }
 246
 247 where_predicate : /where/i /[^;]+/
 248
 249 create_definition : field
 250     | table_constraint
 251     | <error>
 252
 253 comment : /^\s*(?:#|-{2}).*\n/
 254
 255 field : comment(s?) field_name data_type field_meta(s?) comment(s?)
 256     {
 257         my ( $default, @constraints );
 258         for my $meta ( @{ $item[4] } ) {
 259             $default = $meta if $meta->{'meta_type'} eq 'default';
 260             push @constraints, $meta if $meta->{'meta_type'} eq 'constraint';
 261         }
 262
 263         my $null = ( grep { $_->{'type'} eq 'not_null' } @constraints ) ? 0 : 1;
 264
 265         my @comments = ( @{ $item[1] }, @{ $item[5] } );
 266
 267         $return = {
 268             type           => 'field',
 269             name           => $item{'field_name'},
 270             data_type      => $item{'data_type'}{'type'},
 271             size           => $item{'data_type'}{'size'},
 272             list           => $item{'data_type'}{'list'},
 273             null           => $null,
 274             default        => $default->{'value'},
 275             constraints    => [ @constraints ],
 276             comments       => [ @comments ],
 277         }
 278     }
 279     | <error>
 280
 281 field_meta : default_val
 282     |
 283     column_constraint
 284
 285 column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
 286     {
 287         my $desc       = $item{'column_constraint_type'};
 288         my $type       = $desc->{'type'};
 289         my $fields     = $desc->{'fields'}     || [];
 290         my $expression = $desc->{'expression'} || '';
 291
 292         $return              =  {
 293             meta_type        => 'constraint',
 294             name             => $item{'constraint_name'}[0] || '',
 295             type             => $type,
 296             expression       => $type eq 'check' ? $expression : '',
 297             deferreable      => $item{'deferrable'},
 298             deferred         => $item{'deferred'},
 299             reference_table  => $desc->{'reference_table'},
 300             reference_fields => $desc->{'reference_fields'},
 301             match_type       => $desc->{'match_type'},
 302             on_delete_do     => $desc->{'on_delete_do'},
 303             on_update_do     => $desc->{'on_update_do'},
 304         }
 305     }
 306
 307 constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
 308
 309 column_constraint_type : /not null/i { $return = { type => 'not_null' } }
 310     |
 311     /null/
 312         { $return = { type => 'null' } }
 313     |
 314     /unique/
 315         { $return = { type => 'unique' } }
 316     |
 317     /primary key/i
 318         { $return = { type => 'primary_key' } }
 319     |
 320     /check/i '(' /[^)]+/ ')'
 321         { $return = { type => 'check', expression => $item[2] } }
 322     |
 323     /references/i table_name parens_value_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 324     {
 325         $return              =  {
 326             type             => 'foreign_key',
 327             reference_table  => $item[2],
 328             reference_fields => $item[3],
 329             match_type       => $item[4][0],
 330             on_delete_do     => $item[5][0],
 331             on_update_do     => $item[6][0],
 332         }
 333     }
 334
 335 table_name : name_with_opt_quotes
 336
 337 field_name : name_with_opt_quotes
 338
 339 name_with_opt_quotes : double_quote(?) NAME double_quote(?) { $item[2] }
 340
 341 double_quote: /"/
 342
 343 index_name : WORD
 344
 345 data_type : pg_data_type parens_value_list(?)
 346     {
 347         my $type = $item[1];
 348
 349         #
 350         # We can deduce some sizes from the data type's name.
 351         #
 352         my $size;
 353         if ( ref $type eq 'ARRAY' ) {
 354             $size = [ $type->[1] ];
 355             $type = $type->[0];
 356         }
 357         else {
 358             $size = $item[2][0] || '';
 359         }
 360
 361         $return  = {
 362             type => $type,
 363             size => $size,
 364         }
 365     }
 366
 367 pg_data_type :
 368     /(bigint|int8|bigserial|serial8)/ { $return = [ 'integer', 8 ] }
 369     |
 370     /(smallint|int2)/ { $return = [ 'integer', 2 ] }
 371     |
 372     /int(eger)?|int4/ { $return = [ 'integer', 4 ] }
 373     |
 374     /(double precision|float8?)/ { $return = [ 'float', 8 ] }
 375     |
 376     /(real|float4)/ { $return = [ 'real', 4 ] }
 377     |
 378     /serial4?/ { $return = [ 'serial', 4 ] }
 379     |
 380     /bigserial/ { $return = [ 'serial', 8 ] }
 381     |
 382     /(bit varying|varbit)/ { $return = 'varbit' }
 383     |
 384     /character varying/ { $return = 'varchar' }
 385     |
 386     /char(acter)?/ { $return = 'char' }
 387     |
 388     /bool(ean)?/ { $return = 'boolean' }
 389     |
 390     /(bytea|binary data)/ { $return = 'binary' }
 391     |
 392     /timestampz?/ { $return = 'timestamp' }
 393     |
 394     /(bit|box|cidr|circle|date|inet|interval|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|text|time|varchar)/
 395     { $item[1] }
 396
 397 parens_value_list : '(' VALUE(s /,/) ')'
 398     { $item[2] }
 399
 400 parens_word_list : '(' WORD(s /,/) ')'
 401     { $item[2] }
 402
 403 field_size : '(' num_range ')' { $item{'num_range'} }
 404
 405 num_range : DIGITS ',' DIGITS
 406     { $return = $item[1].','.$item[3] }
 407     | DIGITS
 408     { $return = $item[1] }
 409
 410 table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
 411     {
 412         my $desc       = $item{'table_constraint_type'};
 413         my $type       = $desc->{'type'};
 414         my $fields     = $desc->{'fields'};
 415         my $expression = $desc->{'expression'};
 416         my @comments   = ( @{ $item[1] }, @{ $item[-1] } );
 417
 418         $return              =  {
 419             name             => $item{'constraint_name'}[0] || '',
 420             type             => 'constraint',
 421             constraint_type  => $type,
 422             fields           => $type ne 'check' ? $fields : [],
 423             expression       => $type eq 'check' ? $expression : '',
 424             deferreable      => $item{'deferrable'},
 425             deferred         => $item{'deferred'},
 426             reference_table  => $desc->{'reference_table'},
 427             reference_fields => $desc->{'reference_fields'},
 428             match_type       => $desc->{'match_type'}[0],
 429             on_delete_do     => $desc->{'on_delete_do'},
 430             on_update_do     => $desc->{'on_update_do'},
 431             comments         => [ @comments ],
 432         }
 433     }
 434
 435 table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')'
 436     {
 437         $return = {
 438             type   => 'primary_key',
 439             fields => $item[3],
 440         }
 441     }
 442     |
 443     /unique/i '(' name_with_opt_quotes(s /,/) ')'
 444     {
 445         $return    =  {
 446             type   => 'unique',
 447             fields => $item[3],
 448         }
 449     }
 450     |
 451     /check/ '(' /(.+)/ ')'
 452     {
 453         $return        =  {
 454             type       => 'check',
 455             expression => $item[3],
 456         }
 457     }
 458     |
 459     /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 460     {
 461         $return              =  {
 462             type             => 'foreign_key',
 463             fields           => $item[3],
 464             reference_table  => $item[6],
 465             reference_fields => $item[7][0],
 466             match_type       => $item[8][0],
 467             on_delete_do     => $item[9][0],
 468             on_update_do     => $item[10][0],
 469         }
 470     }
 471
 472 deferrable : /not/i /deferrable/i
 473     {
 474         $return = ( $item[1] =~ /not/i ) ? 0 : 1;
 475     }
 476
 477 deferred : /initially/i /(deferred|immediate)/i { $item[2] }
 478
 479 match_type : /match full/i { 'match_full' }
 480     |
 481     /match partial/i { 'match_partial' }
 482
 483 on_delete_do : /on delete/i WORD(s)
 484     { $item[2] }
 485
 486 on_update_do : /on update/i WORD(s)
 487     { $item[2] }
 488
 489 alter : alter_table table_name /add/i table_constraint ';'
 490     {
 491         my $table_name = $item[2];
 492         my $constraint = $item[4];
 493         $constraint->{'type'} = $constraint->{'constraint_type'};
 494         push @{ $tables{ $table_name }{'constraints'} }, $constraint;
 495     }
 496
 497 alter_table : /alter/i /table/i only(?)
 498
 499 only : /only/i
 500
 501 create_table : /create/i /table/i
 502
 503 create_index : /create/i /index/i
 504
 505 default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/
 506     {
 507         my $val =  $item[2] || '';
 508         $val    =~ s/'//g;
 509         $return =  {
 510             meta_type => 'default',
 511             value     => $val,
 512         }
 513     }
 514
 515 name_with_opt_paren : NAME parens_value_list(s?)
 516     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 517
 518 unique : /unique/i { 1 }
 519
 520 key : /key/i | /index/i
 521
 522 table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
 523     {
 524         $return = { type => 'inherits', table_name => $item[3] }
 525     }
 526     |
 527     /with(out)? oids/i
 528     {
 529         $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
 530     }
 531
 532 SEMICOLON : /\s*;\n?/
 533
 534 WORD : /\w+/
 535
 536 DIGITS : /\d+/
 537
 538 COMMA : ','
 539
 540 NAME    : "`" /\w+/ "`"
 541     { $item[2] }
 542     | /\w+/
 543     { $item[1] }
 544     | /[\$\w]+/
 545     { $item[1] }
 546
 547 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 548     { $item[1] }
 549     | /'.*?'/   # XXX doesn't handle embedded quotes
 550     { $item[1] }
 551     | /NULL/
 552     { 'NULL' }
 553
 554 !;
 555
 556 # -------------------------------------------------------------------
 557 sub parse {
 558     my ( $translator, $data ) = @_;
 559     $parser ||= Parse::RecDescent->new($GRAMMAR);
 560
 561     $::RD_TRACE  = $translator->trace ? 1 : undef;
 562     $DEBUG       = $translator->debug;
 563
 564     unless (defined $parser) {
 565         return $translator->error("Error instantiating Parse::RecDescent ".
 566             "instance: Bad grammer");
 567     }
 568
 569     my $result = $parser->startrule($data);
 570     die "Parse failed.\n" unless defined $result;
 571     warn Dumper($result) if $DEBUG;
 572     return $result;
 573 }
 574
 575 1;
 576
 577 #-----------------------------------------------------
 578 # Where man is not nature is barren.
 579 # William Blake
 580 #-----------------------------------------------------
 581
 582 =pod
 583
 584 =head1 AUTHORS
 585
 586 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 587 Allen Day <allenday@users.sourceforge.net>.
 588
 589 =head1 SEE ALSO
 590
 591 perl(1), Parse::RecDescent.
 592
 593 =cut