lib/SQL/Translator/Parser/PostgreSQL.pm

   1 package SQL::Translator::Parser::PostgreSQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: PostgreSQL.pm,v 1.6 2003-02-25 14:55:36 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 =cut
  88
  89 use strict;
  90 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
  91 $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
  92 $DEBUG   = 0 unless defined $DEBUG;
  93
  94 use Data::Dumper;
  95 use Parse::RecDescent;
  96 use Exporter;
  97 use base qw(Exporter);
  98
  99 @EXPORT_OK = qw(parse);
 100
 101 # Enable warnings within the Parse::RecDescent module.
 102 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
 103 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
 104 $::RD_HINT   = 1; # Give out hints to help fix problems.
 105
 106 my $parser; # should we do this?  There's no programmic way to
 107             # change the grammar, so I think this is safe.
 108
 109 $GRAMMAR = q!
 110
 111 { our ( %tables, $table_order ) }
 112
 113 #
 114 # The "eofile" rule makes the parser fail if any "statement" rule
 115 # fails.  Otherwise, the first successful match by a "statement"
 116 # won't cause the failure needed to know that the parse, as a whole,
 117 # failed. -ky
 118 #
 119 startrule : statement(s) eofile { \%tables }
 120
 121 eofile : /^\Z/
 122
 123 statement : create
 124   | comment
 125   | grant
 126   | revoke
 127   | drop
 128   | connect
 129   | <error>
 130
 131 connect : /^\s*\\\connect.*\n/
 132
 133 revoke : /revoke/i WORD(s /,/) /on/i table_name /from/i name_with_opt_quotes(s /,/) ';'
 134     {
 135         my $table_name = $item{'table_name'};
 136         push @{ $tables{ $table_name }{'permissions'} }, {
 137             type       => 'revoke',
 138             actions    => $item[2],
 139             users      => $item[6],
 140         }
 141     }
 142
 143 grant : /grant/i WORD(s /,/) /on/i table_name /to/i name_with_opt_quotes(s /,/) ';'
 144     {
 145         my $table_name = $item{'table_name'};
 146         push @{ $tables{ $table_name }{'permissions'} }, {
 147             type       => 'grant',
 148             actions    => $item[2],
 149             users      => $item[6],
 150         }
 151     }
 152
 153 drop : /drop/i /[^;]*/ ';'
 154
 155 create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
 156     {
 157         my $table_name                       = $item{'table_name'};
 158         $tables{ $table_name }{'order'}      = ++$table_order;
 159         $tables{ $table_name }{'table_name'} = $table_name;
 160
 161         my $i = 1;
 162         my @constraints;
 163         for my $definition ( @{ $item[4] } ) {
 164             if ( $definition->{'type'} eq 'field' ) {
 165                 my $field_name = $definition->{'name'};
 166                 $tables{ $table_name }{'fields'}{ $field_name } =
 167                     { %$definition, order => $i };
 168                 $i++;
 169
 170                 if ( $definition->{'is_primary_key'} ) {
 171                     push @{ $tables{ $table_name }{'indices'} }, {
 172                         type   => 'primary_key',
 173                         fields => [ $field_name ],
 174                     };
 175                 }
 176
 177                 for my $constraint ( @{ $definition->{'constaints'} || [] } ) {
 178                     $constraint->{'fields' } = [ $field_name ];
 179                     push @{$tables{ $table_name }{'constraints'}}, $constraint;
 180                 }
 181             }
 182             elsif ( $definition->{'type'} eq 'constraint' ) {
 183                 $definition->{'type'} = $definition->{'constraint_type'};
 184                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 185             }
 186             else {
 187                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 188             }
 189         }
 190
 191         for my $option ( @{ $item[6] } ) {
 192             $tables{ $table_name }{'table_options'}{ $option->{'type'} } =
 193                 $option;
 194         }
 195
 196         1;
 197     }
 198
 199 create : /create/i unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
 200     {
 201         push @{ $tables{ $item{'table_name'} }{'indices'} },
 202             {
 203                 name   => $item{'index_name'},
 204                 type   => $item{'unique'}[0] ? 'unique' : 'normal',
 205                 fields => $item[9],
 206                 method => $item{'using_method'}[0],
 207             }
 208         ;
 209     }
 210
 211 using_method : /using/i WORD { $item[2] }
 212
 213 where_predicate : /where/i /[^;]+/
 214
 215 create_definition : field
 216     | index
 217     | table_constraint
 218     | <error>
 219
 220 comment : /^\s*(?:#|-{2}).*\n/
 221
 222 field : field_name data_type field_meta(s?)
 223     {
 224         my ( $default, @constraints );
 225         for my $meta ( @{ $item[3] } ) {
 226             $default = $meta if $meta->{'meta_type'} eq 'default';
 227             push @constraints, $meta if $meta->{'meta_type'} eq 'constraint';
 228         }
 229
 230         my $null = ( grep { $_->{'type'} eq 'not_null' } @constraints ) ? 0 : 1;
 231
 232         $return = {
 233             type           => 'field',
 234             name           => $item{'field_name'},
 235             data_type      => $item{'data_type'}{'type'},
 236             size           => $item{'data_type'}{'size'},
 237             list           => $item{'data_type'}{'list'},
 238             null           => $null,
 239             default        => $default->{'value'},
 240             constraints    => [ @constraints ],
 241         }
 242     }
 243     | <error>
 244
 245 field_meta : default_val
 246     |
 247     column_constraint
 248
 249 column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
 250     {
 251         my $desc       = $item{'column_constraint_type'};
 252         my $type       = $desc->{'type'};
 253         my $fields     = $desc->{'fields'}     || [];
 254         my $expression = $desc->{'expression'} || '';
 255
 256         $return              =  {
 257             meta_type        => 'constraint',
 258             name             => $item{'constraint_name'}[0] || '',
 259             type             => $type,
 260             expression       => $type eq 'check' ? $expression : '',
 261             deferreable      => $item{'deferrable'},
 262             deferred         => $item{'deferred'},
 263             reference_table  => $desc->{'reference_table'},
 264             reference_fields => $desc->{'reference_fields'},
 265             match_type       => $desc->{'match_type'},
 266             on_delete_do     => $desc->{'on_delete_do'},
 267             on_update_do     => $desc->{'on_update_do'},
 268         }
 269     }
 270
 271 constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
 272
 273 column_constraint_type : /not null/i { $return = { type => 'not_null' } }
 274     |
 275     /null/
 276         { $return = { type => 'null' } }
 277     |
 278     /unique/
 279         { $return = { type => 'unique' } }
 280     |
 281     /primary key/i
 282         { $return = { type => 'primary_key' } }
 283     |
 284     /check/i '(' /[^)]+/ ')'
 285         { $return = { type => 'check', expression => $item[2] } }
 286     |
 287     /references/i table_name parens_value_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 288     {
 289         $return              =  {
 290             type             => 'foreign_key',
 291             reference_table  => $item[2],
 292             reference_fields => $item[3],
 293             match_type       => $item[4][0],
 294             on_delete_do     => $item[5][0],
 295             on_update_do     => $item[6][0],
 296         }
 297     }
 298
 299 index : primary_key_index
 300     | unique_index
 301     | normal_index
 302
 303 table_name : name_with_opt_quotes
 304
 305 field_name : name_with_opt_quotes
 306
 307 name_with_opt_quotes : double_quote(?) WORD double_quote(?) { $item[2] }
 308
 309 double_quote: /"/
 310
 311 index_name : WORD
 312
 313 data_type : pg_data_type parens_value_list(?)
 314     {
 315         my $type = $item[1];
 316
 317         #
 318         # We can deduce some sizes from the data type's name.
 319         #
 320         my $size;
 321         if ( ref $type eq 'ARRAY' ) {
 322             $size = [ $type->[1] ];
 323             $type = $type->[0];
 324         }
 325         else {
 326             $size = $item[2][0] || '';
 327         }
 328
 329         $return  = {
 330             type => $type,
 331             size => $size,
 332         }
 333     }
 334
 335 pg_data_type :
 336     /(bigint|int8|bigserial|serial8)/ { $return = [ 'integer', 8 ] }
 337     |
 338     /(smallint|int2)/ { $return = [ 'integer', 2 ] }
 339     |
 340     /int(eger)?|int4/ { $return = [ 'integer', 4 ] }
 341     |
 342     /(double precision|float8?)/ { $return = [ 'float', 8 ] }
 343     |
 344     /(real|float4)/ { $return = [ 'real', 4 ] }
 345     |
 346     /serial4?/ { $return = [ 'serial', 4 ] }
 347     |
 348     /bigserial/ { $return = [ 'serial', 8 ] }
 349     |
 350     /(bit varying|varbit)/ { $return = 'varbit' }
 351     |
 352     /character varying/ { $return = 'varchar' }
 353     |
 354     /char(acter)?/ { $return = 'char' }
 355     |
 356     /bool(ean)?/ { $return = 'boolean' }
 357     |
 358     /(bytea|binary data)/ { $return = 'binary' }
 359     |
 360     /timestampz?/ { $return = 'timestamp' }
 361     |
 362     /(bit|box|cidr|circle|date|inet|interval|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|text|time|varchar)/
 363     { $item[1] }
 364
 365 parens_value_list : '(' VALUE(s /,/) ')'
 366     { $item[2] }
 367
 368 parens_word_list : '(' WORD(s /,/) ')'
 369     { $item[2] }
 370
 371 field_size : '(' num_range ')' { $item{'num_range'} }
 372
 373 num_range : DIGITS ',' DIGITS
 374     { $return = $item[1].','.$item[3] }
 375     | DIGITS
 376     { $return = $item[1] }
 377
 378 table_constraint : constraint_name(?) table_constraint_type deferrable(?) deferred(?)
 379     {
 380         my $desc       = $item{'table_constraint_type'};
 381         my $type       = $desc->{'type'};
 382         my $fields     = $desc->{'fields'};
 383         my $expression = $desc->{'expression'};
 384
 385         $return              =  {
 386             name             => $item{'constraint_name'}[0] || '',
 387             type             => 'constraint',
 388             constraint_type  => $type,
 389             fields           => $type ne 'check' ? $fields : [],
 390             expression       => $type eq 'check' ? $expression : '',
 391             deferreable      => $item{'deferrable'},
 392             deferred         => $item{'deferred'},
 393             reference_table  => $desc->{'reference_table'},
 394             reference_fields => $desc->{'reference_fields'},
 395             match_type       => $desc->{'match_type'}[0],
 396             on_delete_do     => $desc->{'on_delete_do'}[0],
 397             on_update_do     => $desc->{'on_update_do'}[0],
 398         }
 399     }
 400
 401 table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')'
 402     {
 403         $return = {
 404             type   => 'primary_key',
 405             fields => $item[3],
 406         }
 407     }
 408     |
 409     /unique/i '(' name_with_opt_quotes(s /,/) ')'
 410     {
 411         $return    =  {
 412             type   => 'unique',
 413             fields => $item[3],
 414         }
 415     }
 416     |
 417     /check/ '(' /(.+)/ ')'
 418     {
 419         $return        =  {
 420             type       => 'check',
 421             expression => $item[3],
 422         }
 423     }
 424     |
 425     /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 426     {
 427         $return              =  {
 428             type             => 'foreign_key',
 429             fields           => $item[3],
 430             reference_table  => $item[6],
 431             reference_fields => $item[7][0],
 432             match_type       => $item[8][0],
 433             on_delete_do     => $item[9][0],
 434             on_update_do     => $item[10][0],
 435         }
 436     }
 437
 438 deferrable : /not/i /deferrable/i
 439     {
 440         $return = ( $item[1] =~ /not/i ) ? 0 : 1;
 441     }
 442
 443 deferred : /initially/i /(deferred|immediate)/i { $item[2] }
 444
 445 match_type : /match full/i { 'match_full' }
 446     |
 447     /match partial/i { 'match_partial' }
 448
 449 on_delete_do : /on delete/i WORD
 450     { $item[2] }
 451
 452 on_update_do : /on update/i WORD
 453     { $item[2] }
 454
 455 create_table : /create/i /table/i
 456
 457 create_index : /create/i /index/i
 458
 459 default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/
 460     {
 461         my $val =  $item[2] || '';
 462         $val    =~ s/'//g;
 463         $return =  {
 464             meta_type => 'default',
 465             value     => $val,
 466         }
 467     }
 468
 469 auto_inc : /auto_increment/i { 1 }
 470
 471 primary_key : /primary/i /key/i { 1 }
 472
 473 primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
 474     {
 475         $return    = {
 476             name   => $item{'index_name'}[0],
 477             type   => 'primary_key',
 478             fields => $item[4],
 479         }
 480     }
 481
 482 normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 483     {
 484         $return    = {
 485             name   => $item{'index_name'}[0],
 486             type   => 'normal',
 487             fields => $item[4],
 488         }
 489     }
 490
 491 unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 492     {
 493         $return    = {
 494             name   => $item{'index_name'}[0],
 495             type   => 'unique',
 496             fields => $item[5],
 497         }
 498     }
 499
 500 name_with_opt_paren : NAME parens_value_list(s?)
 501     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 502
 503 unique : /unique/i { 1 }
 504
 505 key : /key/i | /index/i
 506
 507 table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
 508     {
 509         $return = { type => 'inherits', table_name => $item[3] }
 510     }
 511     |
 512     /with(out)? oids/i
 513     {
 514         $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
 515     }
 516
 517 SEMICOLON : /\s*;\n?/
 518
 519 WORD : /\w+/
 520
 521 DIGITS : /\d+/
 522
 523 COMMA : ','
 524
 525 NAME    : "`" /\w+/ "`"
 526     { $item[2] }
 527     | /\w+/
 528     { $item[1] }
 529
 530 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 531     { $item[1] }
 532     | /'.*?'/   # XXX doesn't handle embedded quotes
 533     { $item[1] }
 534     | /NULL/
 535     { 'NULL' }
 536
 537 !;
 538
 539 # -------------------------------------------------------------------
 540 sub parse {
 541     my ( $translator, $data ) = @_;
 542     $parser ||= Parse::RecDescent->new($GRAMMAR);
 543
 544     $::RD_TRACE  = $translator->trace ? 1 : undef;
 545     $DEBUG       = $translator->debug;
 546
 547     unless (defined $parser) {
 548         return $translator->error("Error instantiating Parse::RecDescent ".
 549             "instance: Bad grammer");
 550     }
 551
 552     my $result = $parser->startrule($data);
 553     die "Parse failed.\n" unless defined $result;
 554     warn Dumper($result) if $DEBUG;
 555     return $result;
 556 }
 557
 558 1;
 559
 560 #-----------------------------------------------------
 561 # Where man is not nature is barren.
 562 # William Blake
 563 #-----------------------------------------------------
 564
 565 =pod
 566
 567 =head1 AUTHORS
 568
 569 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 570 Allen Day <allenday@users.sourceforge.net>.
 571
 572 =head1 SEE ALSO
 573
 574 perl(1), Parse::RecDescent.
 575
 576 =cut