Added rules to catch common (but useless) statements.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / PostgreSQL.pm
1 package SQL::Translator::Parser::PostgreSQL;
2
3 # -------------------------------------------------------------------
4 # $Id: PostgreSQL.pm,v 1.14 2003-05-03 15:40:18 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 View table:
107
108     CREATE [ OR REPLACE ] VIEW view [ ( column name list ) ] AS SELECT query
109
110 =cut
111
112 use strict;
113 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
114 $VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
115 $DEBUG   = 0 unless defined $DEBUG;
116
117 use Data::Dumper;
118 use Parse::RecDescent;
119 use Exporter;
120 use base qw(Exporter);
121
122 @EXPORT_OK = qw(parse);
123
124 # Enable warnings within the Parse::RecDescent module.
125 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
126 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
127 $::RD_HINT   = 1; # Give out hints to help fix problems.
128
129 my $parser; # should we do this?  There's no programmic way to 
130             # change the grammar, so I think this is safe.
131
132 $GRAMMAR = q!
133
134 { our ( %tables, $table_order ) }
135
136 #
137 # The "eofile" rule makes the parser fail if any "statement" rule
138 # fails.  Otherwise, the first successful match by a "statement" 
139 # won't cause the failure needed to know that the parse, as a whole,
140 # failed. -ky
141 #
142 startrule : statement(s) eofile { \%tables }
143
144 eofile : /^\Z/
145
146 statement : create
147   | comment
148   | alter
149   | grant
150   | revoke
151   | drop
152   | connect
153   | set
154   | <error>
155
156 connect : /^\s*\\\connect.*\n/
157
158 set : /SET/ /[^;]*/ ';'
159
160 revoke : /revoke/i WORD(s /,/) /on/i table_name /from/i name_with_opt_quotes(s /,/) ';'
161     {
162         my $table_name = $item{'table_name'};
163         push @{ $tables{ $table_name }{'permissions'} }, {
164             type       => 'revoke',
165             actions    => $item[2],
166             users      => $item[6],
167         }
168     }
169
170 grant : /grant/i WORD(s /,/) /on/i table_name /to/i name_with_opt_quotes(s /,/) ';'
171     {
172         my $table_name = $item{'table_name'};
173         push @{ $tables{ $table_name }{'permissions'} }, {
174             type       => 'grant',
175             actions    => $item[2],
176             users      => $item[6],
177         }
178     }
179
180 drop : /drop/i /[^;]*/ ';'
181
182 #
183 # Create table.
184 #
185 create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
186     {
187         my $table_name                       = $item{'table_name'};
188         $tables{ $table_name }{'order'}      = ++$table_order;
189         $tables{ $table_name }{'table_name'} = $table_name;
190
191         my $i = 1;
192         my @constraints;
193         for my $definition ( @{ $item[4] } ) {
194             if ( $definition->{'type'} eq 'field' ) {
195                 my $field_name = $definition->{'name'};
196                 $tables{ $table_name }{'fields'}{ $field_name } = 
197                     { %$definition, order => $i };
198                 $i++;
199                                 
200                 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
201                     $constraint->{'fields'} = [ $field_name ];
202                     push @{ $tables{ $table_name }{'constraints'} },
203                         $constraint;
204                 }
205             }
206             elsif ( $definition->{'type'} eq 'constraint' ) {
207                 $definition->{'type'} = $definition->{'constraint_type'};
208                 # group FKs at the field level
209                 if ( $definition->{'type'} eq 'foreign_key' ) {
210                     for my $fld ( @{ $definition->{'fields'} || [] } ) {
211                         push @{ 
212                             $tables{$table_name}{'fields'}{$fld}{'constraints'}
213                         }, $definition;
214                     }
215                 }
216                 else {
217                     push @{ $tables{ $table_name }{'constraints'} }, 
218                         $definition;
219                 }
220             }
221             else {
222                 push @{ $tables{ $table_name }{'indices'} }, $definition;
223             }
224         }
225
226         for my $option ( @{ $item[6] } ) {
227             $tables{ $table_name }{'table_options(s?)'}{ $option->{'type'} } = 
228                 $option;
229         }
230
231         1;
232     }
233
234 #
235 # Create index.
236 #
237 create : /create/i unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
238     {
239         push @{ $tables{ $item{'table_name'} }{'indices'} },
240             {
241                 name   => $item{'index_name'},
242                 type   => $item{'unique'}[0] ? 'unique' : 'normal',
243                 fields => $item[9],
244                 method => $item{'using_method'}[0],
245             }
246         ;
247     }
248
249 #
250 # Create anything else (e.g., domain, function, etc.)
251 #
252 create : /create/i WORD /[^;]+/ ';'
253
254 using_method : /using/i WORD { $item[2] }
255
256 where_predicate : /where/i /[^;]+/
257
258 create_definition : field
259     | table_constraint
260     | <error>
261
262 comment : /^\s*(?:#|-{2}).*\n/
263
264 field : comment(s?) field_name data_type field_meta(s?) comment(s?)
265     {
266         my ( $default, @constraints, $is_pk );
267         for my $meta ( @{ $item[4] } ) {
268             $default = $meta if $meta->{'meta_type'} eq 'default';
269             push @constraints, $meta if $meta->{'meta_type'} eq 'constraint';
270             $is_pk = $meta->{'type'} eq 'primary_key';
271         }
272
273         my $null = ( grep { $_->{'type'} eq 'not_null' } @constraints ) ? 0 : 1;
274
275         my @comments = ( @{ $item[1] }, @{ $item[5] } );
276
277         $return = {
278             type           => 'field',
279             name           => $item{'field_name'}, 
280             data_type      => $item{'data_type'}{'type'},
281             size           => $item{'data_type'}{'size'},
282             null           => $null,
283             default        => $default->{'value'},
284             constraints    => [ @constraints ],
285             comments       => [ @comments ],
286             is_primary_key => $is_pk || 0,
287         } 
288     }
289     | <error>
290
291 field_meta : default_val
292     |
293     column_constraint
294
295 column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
296     {
297         my $desc       = $item{'column_constraint_type'};
298         my $type       = $desc->{'type'};
299         my $fields     = $desc->{'fields'}     || [];
300         my $expression = $desc->{'expression'} || '';
301
302         $return              =  {
303             meta_type        => 'constraint',
304             name             => $item{'constraint_name'}[0] || '',
305             type             => $type,
306             expression       => $type eq 'check' ? $expression : '',
307             deferreable      => $item{'deferrable'},
308             deferred         => $item{'deferred'},
309             reference_table  => $desc->{'reference_table'},
310             reference_fields => $desc->{'reference_fields'},
311             match_type       => $desc->{'match_type'},
312             on_delete_do     => $desc->{'on_delete_do'},
313             on_update_do     => $desc->{'on_update_do'},
314         } 
315     }
316
317 constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
318
319 column_constraint_type : /not null/i { $return = { type => 'not_null' } }
320     |
321     /null/ 
322         { $return = { type => 'null' } }
323     |
324     /unique/ 
325         { $return = { type => 'unique' } }
326     |
327     /primary key/i 
328         { $return = { type => 'primary_key' } }
329     |
330     /check/i '(' /[^)]+/ ')' 
331         { $return = { type => 'check', expression => $item[2] } }
332     |
333     /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
334     {
335         my ( $on_delete, $on_update );
336         for my $action ( @{ $item[5] || [] } ) {
337             $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
338             $on_update = $action->{'action'} if $action->{'type'} eq 'update';
339         }
340
341         $return              =  {
342             type             => 'foreign_key',
343             reference_table  => $item[2],
344             reference_fields => $item[3][0],
345             match_type       => $item[4][0],
346             on_delete_do     => $on_delete,
347             on_update_do     => $on_update,
348         }
349     }
350
351 table_name : name_with_opt_quotes
352
353 field_name : name_with_opt_quotes
354
355 name_with_opt_quotes : double_quote(?) NAME double_quote(?) { $item[2] }
356
357 double_quote: /"/
358
359 index_name : WORD
360
361 data_type : pg_data_type parens_value_list(?)
362     { 
363         my $data_type = $item[1];
364
365         #
366         # We can deduce some sizes from the data type's name.
367         #
368         $data_type->{'size'} ||= $item[2];
369
370         $return  = $data_type;
371     }
372
373 pg_data_type :
374     /(bigint|int8|bigserial|serial8)/ 
375         { 
376             $return = { 
377                 type           => 'integer',
378                 size           => [8],
379                 auto_increment => 1,
380             };
381         }
382     |
383     /(smallint|int2)/ 
384         { 
385             $return = {
386                 type => 'integer', 
387                 size => [2],
388             };
389         }
390     |
391     /int(eger)?|int4/ 
392         { 
393             $return = {
394                 type => 'integer', 
395                 size => [4],
396             };
397         }
398     |
399     /(double precision|float8?)/ 
400         { 
401             $return = {
402                 type => 'float', 
403                 size => [8],
404             }; 
405         }
406     |
407     /(real|float4)/ 
408         { 
409             $return = {
410                 type => 'real', 
411                 size => [4],
412             };
413         }
414     |
415     /serial4?/ 
416         { 
417             $return = { 
418                 type           => 'integer',
419                 size           => [4], 
420                 auto_increment => 1,
421             };
422         }
423     |
424     /bigserial/ 
425         { 
426             $return = { 
427                 type           => 'integer', 
428                 size           => [8], 
429                 auto_increment => 1,
430             };
431         }
432     |
433     /(bit varying|varbit)/ 
434         { 
435             $return = { type => 'varbit' };
436         }
437     |
438     /character varying/ 
439         { 
440             $return = { type => 'varchar' };
441         }
442     |
443     /char(acter)?/ 
444         { 
445             $return = { type => 'char' };
446         }
447     |
448     /bool(ean)?/ 
449         { 
450             $return = { type => 'boolean' };
451         }
452     |
453     /(bytea|binary data)/ 
454         { 
455             $return = { type => 'binary' };
456         }
457     |
458     /timestampz?/ 
459         { 
460             $return = { type => 'timestamp' };
461         }
462     |
463     /(bit|box|cidr|circle|date|inet|interval|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|text|time|varchar)/
464         { 
465             $return = { type => $item[1] };
466         }
467
468 parens_value_list : '(' VALUE(s /,/) ')'
469     { $item[2] }
470
471 parens_word_list : '(' WORD(s /,/) ')'
472     { $item[2] }
473
474 field_size : '(' num_range ')' { $item{'num_range'} }
475
476 num_range : DIGITS ',' DIGITS
477     { $return = $item[1].','.$item[3] }
478     | DIGITS
479     { $return = $item[1] }
480
481 table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
482     {
483         my $desc       = $item{'table_constraint_type'};
484         my $type       = $desc->{'type'};
485         my $fields     = $desc->{'fields'};
486         my $expression = $desc->{'expression'};
487         my @comments   = ( @{ $item[1] }, @{ $item[-1] } );
488
489         $return              =  {
490             name             => $item{'constraint_name'}[0] || '',
491             type             => 'constraint',
492             constraint_type  => $type,
493             fields           => $type ne 'check' ? $fields : [],
494             expression       => $type eq 'check' ? $expression : '',
495             deferreable      => $item{'deferrable'},
496             deferred         => $item{'deferred'},
497             reference_table  => $desc->{'reference_table'},
498             reference_fields => $desc->{'reference_fields'},
499             match_type       => $desc->{'match_type'}[0],
500             on_delete_do     => $desc->{'on_delete_do'},
501             on_update_do     => $desc->{'on_update_do'},
502             comments         => [ @comments ],
503         } 
504     }
505
506 table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')' 
507     { 
508         $return = {
509             type   => 'primary_key',
510             fields => $item[3],
511         }
512     }
513     |
514     /unique/i '(' name_with_opt_quotes(s /,/) ')' 
515     { 
516         $return    =  {
517             type   => 'unique',
518             fields => $item[3],
519         }
520     }
521     |
522     /check/ '(' /(.+)/ ')'
523     {
524         $return        =  {
525             type       => 'check',
526             expression => $item[3],
527         }
528     }
529     |
530     /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
531     {
532         my ( $on_delete, $on_update );
533         for my $action ( @{ $item[9] || [] } ) {
534             $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
535             $on_update = $action->{'action'} if $action->{'type'} eq 'update';
536         }
537         
538         $return              =  {
539             type             => 'foreign_key',
540             fields           => $item[3],
541             reference_table  => $item[6],
542             reference_fields => $item[7][0],
543             match_type       => $item[8][0],
544             on_delete_do     => $on_delete || '',
545             on_update_do     => $on_update || '',
546         }
547     }
548
549 deferrable : /not/i /deferrable/i 
550     { 
551         $return = ( $item[1] =~ /not/i ) ? 0 : 1;
552     }
553
554 deferred : /initially/i /(deferred|immediate)/i { $item[2] }
555
556 match_type : /match full/i { 'match_full' }
557     |
558     /match partial/i { 'match_partial' }
559
560 key_action : key_delete 
561     |
562     key_update
563
564 key_delete : /on delete/i key_mutation
565     { 
566         $return => { 
567             type   => 'delete',
568             action => $item[2],
569         };
570     }
571
572 key_update : /on update/i key_mutation
573     { 
574         $return => { 
575             type   => 'update',
576             action => $item[2],
577         };
578     }
579
580 key_mutation : /no action/i { $return = 'no_action' }
581     |
582     /restrict/i { $return = 'restrict' }
583     |
584     /cascade/i { $return = 'cascade' }
585     |
586     /set null/i { $return = 'set_null' }
587     |
588     /set default/i { $return = 'set_default' }
589
590 alter : alter_table table_name /add/i table_constraint ';' 
591     { 
592         my $table_name = $item[2];
593         my $constraint = $item[4];
594         $constraint->{'type'} = $constraint->{'constraint_type'};
595         push @{ $tables{ $table_name }{'constraints'} }, $constraint;
596     }
597
598 alter_table : /alter/i /table/i only(?)
599
600 only : /only/i
601
602 create_table : /create/i /table/i
603
604 create_index : /create/i /index/i
605
606 default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/ 
607     { 
608         my $val =  $item[2] || '';
609         $val    =~ s/'//g; 
610         $return =  {
611             meta_type => 'default',
612             value     => $val,
613         }
614     }
615
616 name_with_opt_paren : NAME parens_value_list(s?)
617     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
618
619 unique : /unique/i { 1 }
620
621 key : /key/i | /index/i
622
623 table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
624     { 
625         $return = { type => 'inherits', table_name => $item[3] }
626     }
627     |
628     /with(out)? oids/i
629     {
630         $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
631     }
632
633 SEMICOLON : /\s*;\n?/
634
635 WORD : /\w+/
636
637 DIGITS : /\d+/
638
639 COMMA : ','
640
641 NAME    : "`" /\w+/ "`"
642     { $item[2] }
643     | /\w+/
644     { $item[1] }
645     | /[\$\w]+/
646     { $item[1] }
647
648 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
649     { $item[1] }
650     | /'.*?'/   # XXX doesn't handle embedded quotes
651     { $item[1] }
652     | /NULL/
653     { 'NULL' }
654
655 !;
656
657 # -------------------------------------------------------------------
658 sub parse {
659     my ( $translator, $data ) = @_;
660     $parser ||= Parse::RecDescent->new($GRAMMAR);
661
662     $::RD_TRACE  = $translator->trace ? 1 : undef;
663     $DEBUG       = $translator->debug;
664
665     unless (defined $parser) {
666         return $translator->error("Error instantiating Parse::RecDescent ".
667             "instance: Bad grammer");
668     }
669
670     my $result = $parser->startrule($data);
671     die "Parse failed.\n" unless defined $result;
672     warn Dumper($result) if $DEBUG;
673     return $result;
674 }
675
676 1;
677
678 #-----------------------------------------------------
679 # Where man is not nature is barren.
680 # William Blake
681 #-----------------------------------------------------
682
683 =pod
684
685 =head1 AUTHORS
686
687 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
688 Allen Day <allenday@ucla.edu>.
689
690 =head1 SEE ALSO
691
692 perl(1), Parse::RecDescent.
693
694 =cut