lib/SQL/Translator/Parser/PostgreSQL.pm

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