lib/SQL/Translator/Parser/PostgreSQL.pm

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