Some syntax fixes, package name was wrong, added Mikey's name to AUTHORS.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / PostgreSQL.pm
index 4e7d049..ccc6710 100644 (file)
@@ -1,9 +1,10 @@
 package SQL::Translator::Parser::PostgreSQL;
 
 # -------------------------------------------------------------------
-# $Id: PostgreSQL.pm,v 1.3 2003-02-25 02:03:55 allenday Exp $
+# $Id: PostgreSQL.pm,v 1.10 2003-04-02 01:46:16 kycl4rk Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
+#                    Allen Day <allenday@users.sourceforge.net>,
 #                    darren chamberlain <darren@cpan.org>,
 #                    Chris Mungall <cjm@fruitfly.org>
 #
@@ -18,7 +19,7 @@ package SQL::Translator::Parser::PostgreSQL;
 #
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
 # 02111-1307  USA
 # -------------------------------------------------------------------
 
@@ -36,13 +37,77 @@ SQL::Translator::Parser::PostgreSQL - parser for PostgreSQL
 
 =head1 DESCRIPTION
 
-The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
+The grammar was started from the MySQL parsers.  Here is the description 
+from PostgreSQL:
+
+Table:
+(http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createtable.html)
+
+  CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
+      { column_name data_type [ DEFAULT default_expr ] 
+         [ column_constraint [, ... ] ]
+      | table_constraint }  [, ... ]
+  )
+  [ INHERITS ( parent_table [, ... ] ) ]
+  [ WITH OIDS | WITHOUT OIDS ]
+  
+  where column_constraint is:
+  
+  [ CONSTRAINT constraint_name ]
+  { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
+    CHECK (expression) |
+    REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
+      [ ON DELETE action ] [ ON UPDATE action ] }
+  [ DEFERRABLE | NOT DEFERRABLE ] 
+  [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
+  
+  and table_constraint is:
+  
+  [ CONSTRAINT constraint_name ]
+  { UNIQUE ( column_name [, ... ] ) |
+    PRIMARY KEY ( column_name [, ... ] ) |
+    CHECK ( expression ) |
+    FOREIGN KEY ( column_name [, ... ] ) 
+     REFERENCES reftable [ ( refcolumn [, ... ] ) ]
+      [ MATCH FULL | MATCH PARTIAL ] 
+      [ ON DELETE action ] [ ON UPDATE action ] }
+  [ DEFERRABLE | NOT DEFERRABLE ] 
+  [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
+
+Index:
+(http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createindex.html)
+
+  CREATE [ UNIQUE ] INDEX index_name ON table
+      [ USING acc_method ] ( column [ ops_name ] [, ...] )
+      [ WHERE predicate ]
+  CREATE [ UNIQUE ] INDEX index_name ON table
+      [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
+      [ WHERE predicate ]
+
+Alter table:
+
+  ALTER TABLE [ ONLY ] table [ * ]
+      ADD [ COLUMN ] column type [ column_constraint [ ... ] ]
+  ALTER TABLE [ ONLY ] table [ * ]
+      ALTER [ COLUMN ] column { SET DEFAULT value | DROP DEFAULT }
+  ALTER TABLE [ ONLY ] table [ * ]
+      ALTER [ COLUMN ] column SET STATISTICS integer
+  ALTER TABLE [ ONLY ] table [ * ]
+      RENAME [ COLUMN ] column TO newcolumn
+  ALTER TABLE table
+      RENAME TO new_table
+  ALTER TABLE table
+      ADD table_constraint_definition
+  ALTER TABLE [ ONLY ] table 
+          DROP CONSTRAINT constraint { RESTRICT | CASCADE }
+  ALTER TABLE table
+          OWNER TO new_owner 
 
 =cut
 
 use strict;
 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
@@ -64,79 +129,153 @@ $GRAMMAR = q!
 
 { our ( %tables, $table_order ) }
 
-startrule : statement(s) { \%tables }
+#
+# The "eofile" rule makes the parser fail if any "statement" rule
+# fails.  Otherwise, the first successful match by a "statement" 
+# won't cause the failure needed to know that the parse, as a whole,
+# failed. -ky
+#
+startrule : statement(s) eofile { \%tables }
 
-statement : comment
+eofile : /^\Z/
+
+statement : create
+  | comment
+  | alter
+  | grant
+  | revoke
   | drop
-  | create
+  | connect
+  | set
   | <error>
 
-drop : /drop/i WORD(s) ';'
+connect : /^\s*\\\connect.*\n/
+
+set : /SET/ /[^;]*/ ';'
+
+revoke : /revoke/i WORD(s /,/) /on/i table_name /from/i name_with_opt_quotes(s /,/) ';'
+    {
+        my $table_name = $item{'table_name'};
+        push @{ $tables{ $table_name }{'permissions'} }, {
+            type       => 'revoke',
+            actions    => $item[2],
+            users      => $item[6],
+        }
+    }
 
+grant : /grant/i WORD(s /,/) /on/i table_name /to/i name_with_opt_quotes(s /,/) ';'
+    {
+        my $table_name = $item{'table_name'};
+        push @{ $tables{ $table_name }{'permissions'} }, {
+            type       => 'grant',
+            actions    => $item[2],
+            users      => $item[6],
+        }
+    }
+
+drop : /drop/i /[^;]*/ ';'
+
+#
+# Create table.
+#
 create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
-  {
-   my $table_name                       = $item{'table_name'};
-   $tables{ $table_name }{'order'}      = ++$table_order;
-   $tables{ $table_name }{'table_name'} = $table_name;
-
-   my $i = 1;
-   for my $definition ( @{ $item[4] } ) {
-        if ( $definition->{'type'} eq 'field' ) {
-          my $field_name = $definition->{'name'};
-          $tables{ $table_name }{'fields'}{ $field_name } = 
-                { %$definition, order => $i };
-          $i++;
+    {
+        my $table_name                       = $item{'table_name'};
+        $tables{ $table_name }{'order'}      = ++$table_order;
+        $tables{ $table_name }{'table_name'} = $table_name;
+
+        my $i = 1;
+        my @constraints;
+        for my $definition ( @{ $item[4] } ) {
+            if ( $definition->{'type'} eq 'field' ) {
+                my $field_name = $definition->{'name'};
+                $tables{ $table_name }{'fields'}{ $field_name } = 
+                    { %$definition, order => $i };
+                $i++;
                                
-          if ( $definition->{'is_primary_key'} ) {
-                push @{ $tables{ $table_name }{'indices'} },
-                  {
-                       type   => 'primary_key',
-                       fields => [ $field_name ],
-                  }
-                        ;
-          }
-        }
-        else {
-          push @{ $tables{ $table_name }{'indices'} },
-                $definition;
-        }
-   }
-
-   for my $opt ( @{ $item{'table_option'} } ) {
-        if ( my ( $key, $val ) = each %$opt ) {
-          $tables{ $table_name }{'table_options'}{ $key } = $val;
-        }
-   }
-  }
-
-  create : /CREATE/i unique(?) /(INDEX|KEY)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
+                if ( $definition->{'is_primary_key'} ) {
+                    push @{ $tables{ $table_name }{'indices'} }, {
+                        type   => 'primary_key',
+                        fields => [ $field_name ],
+                    };
+                }
+
+                for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
+                    $constraint->{'fields'} = [ $field_name ];
+                    push @{ $tables{ $table_name }{'constraints'} }, 
+                        $constraint;
+                }
+            }
+            elsif ( $definition->{'type'} eq 'constraint' ) {
+                $definition->{'type'} = $definition->{'constraint_type'};
+                # group FKs at the field level
+                if ( $definition->{'type'} eq 'foreign_key' ) {
+                    for my $fld ( @{ $definition->{'fields'} || [] } ) {
+                        push @{ 
+                            $tables{$table_name}{'fields'}{$fld}{'constraints'}
+                        }, $definition;
+                    }
+                }
+                else {
+                    push @{ $tables{ $table_name }{'constraints'} }, 
+                        $definition;
+                }
+            }
+            else {
+                push @{ $tables{ $table_name }{'indices'} }, $definition;
+            }
+        }
+
+        for my $option ( @{ $item[6] } ) {
+            $tables{ $table_name }{'table_options'}{ $option->{'type'} } = 
+                $option;
+        }
+
+        1;
+    }
+
+#
+# Create index.
+#
+create : /create/i unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
     {
         push @{ $tables{ $item{'table_name'} }{'indices'} },
             {
-                name   => $item[4],
-                type   => $item[2] ? 'unique' : 'normal',
-                fields => $item[8],
+                name   => $item{'index_name'},
+                type   => $item{'unique'}[0] ? 'unique' : 'normal',
+                fields => $item[9],
+                method => $item{'using_method'}[0],
             }
         ;
     }
 
-create_definition : index
-    | field
+#
+# Create anything else (e.g., domain, function, etc.)
+#
+create : /create/i WORD /[^;]+/ ';'
+
+using_method : /using/i WORD { $item[2] }
+
+where_predicate : /where/i /[^;]+/
+
+create_definition : field
+    | table_constraint
     | <error>
 
 comment : /^\s*(?:#|-{2}).*\n/
 
-blank : /\s*/
-
-field : field_name data_type field_qualifier(s?)
+field : comment(s?) field_name data_type field_meta(s?) comment(s?)
     {
-        my %qualifiers = map { %$_ } @{ $item{'field_qualifier'} || [] };
-        my $null = defined $item{'not_null'} ? $item{'not_null'} : 1;
-        delete $qualifiers{'not_null'};
-        if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
-            $qualifiers{ $_ } = 1 for @type_quals;
+        my ( $default, @constraints );
+        for my $meta ( @{ $item[4] } ) {
+            $default = $meta if $meta->{'meta_type'} eq 'default';
+            push @constraints, $meta if $meta->{'meta_type'} eq 'constraint';
         }
 
+        my $null = ( grep { $_->{'type'} eq 'not_null' } @constraints ) ? 0 : 1;
+
+        my @comments = ( @{ $item[1] }, @{ $item[5] } );
+
         $return = { 
             type           => 'field',
             name           => $item{'field_name'}, 
@@ -144,186 +283,265 @@ field : field_name data_type field_qualifier(s?)
             size           => $item{'data_type'}{'size'},
             list           => $item{'data_type'}{'list'},
             null           => $null,
-            %qualifiers,
+            default        => $default->{'value'},
+            constraints    => [ @constraints ],
+            comments       => [ @comments ],
         } 
     }
     | <error>
 
-field_qualifier : not_null
-    { 
-        $return = { 
-             null => $item{'not_null'},
-        } 
-    }
-
-field_qualifier : default_val
-    { 
-        $return = { 
-             default => $item{'default_val'},
-        } 
-    }
-
-field_qualifier : auto_inc
-    { 
-        $return = { 
-             is_auto_inc => $item{'auto_inc'},
-        } 
-    }
+field_meta : default_val
+    |
+    column_constraint
 
-field_qualifier : ',' primary_key '(' field_name ')'
-    { 
-        $return = { 
-             is_primary_key => $item{'primary_key'},
+column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
+    {
+        my $desc       = $item{'column_constraint_type'};
+        my $type       = $desc->{'type'};
+        my $fields     = $desc->{'fields'}     || [];
+        my $expression = $desc->{'expression'} || '';
+
+        $return              =  {
+            meta_type        => 'constraint',
+            name             => $item{'constraint_name'}[0] || '',
+            type             => $type,
+            expression       => $type eq 'check' ? $expression : '',
+            deferreable      => $item{'deferrable'},
+            deferred         => $item{'deferred'},
+            reference_table  => $desc->{'reference_table'},
+            reference_fields => $desc->{'reference_fields'},
+            match_type       => $desc->{'match_type'},
+            on_delete_do     => $desc->{'on_delete_do'},
+            on_update_do     => $desc->{'on_update_do'},
         } 
     }
 
-field_qualifier : ',' foreign_key '(' field_name ')' foreign_key_reference foreign_table_name '(' foreign_field_name ')'
-    { 
-        $return = {
-             is_foreign_key => $item{'foreign_key'},
-                        foreign_table => $item{'foreign_table_name'},
-                        foreign_field => $item{'foreign_field_name'},
-                        name => $item{'field_name'},
+constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
+
+column_constraint_type : /not null/i { $return = { type => 'not_null' } }
+    |
+    /null/ 
+        { $return = { type => 'null' } }
+    |
+    /unique/ 
+        { $return = { type => 'unique' } }
+    |
+    /primary key/i 
+        { $return = { type => 'primary_key' } }
+    |
+    /check/i '(' /[^)]+/ ')' 
+        { $return = { type => 'check', expression => $item[2] } }
+    |
+    /references/i table_name parens_word_list(?) match_type(?) on_delete_do(?) on_update_do(?)
+    {
+        $return              =  {
+            type             => 'foreign_key',
+            reference_table  => $item[2],
+            reference_fields => $item[3][0],
+            match_type       => $item[4][0],
+            on_delete_do     => $item[5][0],
+            on_update_do     => $item[6][0],
         }
     }
 
-field_qualifier : unsigned
-    { 
-        $return = { 
-             is_unsigned => $item{'unsigned'},
-        } 
-    }
-
-index : primary_key_index
-    | unique_index
-    | fulltext_index
-    | normal_index
-
-table_name   : WORD
+table_name : name_with_opt_quotes
 
-foreign_table_name   : WORD
+field_name : name_with_opt_quotes
 
-field_name   : WORD
+name_with_opt_quotes : double_quote(?) NAME double_quote(?) { $item[2] }
 
-foreign_field_name   : WORD
+double_quote: /"/
 
-index_name   : WORD
+index_name : WORD
 
-data_type    : WORD parens_value_list(s?) type_qualifier(s?)
+data_type : pg_data_type parens_value_list(?)
     { 
         my $type = $item[1];
 
-        my $size; # field size, applicable only to non-set fields
-        my $list; # set list, applicable only to sets (duh)
-
-
-        if(uc($type) =~ /^SERIAL$/){
-            $type = 'int';
-        } elsif ( uc($type) =~ /^(SET|ENUM)$/ ) {
-            $size = undef;
-            $list = $item[2][0];
+        #
+        # We can deduce some sizes from the data type's name.
+        #
+        my $size; 
+        if ( ref $type eq 'ARRAY' ) {
+            $size = [ $type->[1] ];
+            $type = $type->[0];
         }
         else {
-            $size = $item[2][0];
-            $list = [];
+            $size = $item[2][0] || '';
         }
 
-        if(uc($type) =~ /^VARCHAR$/ and not defined($size)){ $size = [255] }
-
-        $return        = { 
-            type       => $type,
-            size       => $size,
-            list       => $list,
-            qualifiers => $item[3],
+        $return  = { 
+            type => $type,
+            size => $size,
         } 
     }
 
+pg_data_type :
+    /(bigint|int8|bigserial|serial8)/ { $return = [ 'integer', 8 ] }
+    |
+    /(smallint|int2)/ { $return = [ 'integer', 2 ] }
+    |
+    /int(eger)?|int4/ { $return = [ 'integer', 4 ] }
+    |
+    /(double precision|float8?)/ { $return = [ 'float', 8 ] }
+    |
+    /(real|float4)/ { $return = [ 'real', 4 ] }
+    |
+    /serial4?/ { $return = [ 'serial', 4 ] }
+    |
+    /bigserial/ { $return = [ 'serial', 8 ] }
+    |
+    /(bit varying|varbit)/ { $return = 'varbit' }
+    |
+    /character varying/ { $return = 'varchar' }
+    |
+    /char(acter)?/ { $return = 'char' }
+    |
+    /bool(ean)?/ { $return = 'boolean' }
+    |
+    /(bytea|binary data)/ { $return = 'binary' }
+    |
+    /timestampz?/ { $return = 'timestamp' }
+    |
+    /(bit|box|cidr|circle|date|inet|interval|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|text|time|varchar)/
+    { $item[1] }
+
 parens_value_list : '(' VALUE(s /,/) ')'
     { $item[2] }
 
-type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
-    { lc $item[1] }
-
-field_type   : WORD
+parens_word_list : '(' WORD(s /,/) ')'
+    { $item[2] }
 
-field_size   : '(' num_range ')' { $item{'num_range'} }
+field_size : '(' num_range ')' { $item{'num_range'} }
 
-num_range    : DIGITS ',' DIGITS
+num_range : DIGITS ',' DIGITS
     { $return = $item[1].','.$item[3] }
     | DIGITS
     { $return = $item[1] }
 
-create_table : /create/i /table/i
-
-create_index : /create/i /index/i
-
-not_null     : /not/i /null/i { $return = 0 }
+table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
+    {
+        my $desc       = $item{'table_constraint_type'};
+        my $type       = $desc->{'type'};
+        my $fields     = $desc->{'fields'};
+        my $expression = $desc->{'expression'};
+        my @comments   = ( @{ $item[1] }, @{ $item[-1] } );
+
+        $return              =  {
+            name             => $item{'constraint_name'}[0] || '',
+            type             => 'constraint',
+            constraint_type  => $type,
+            fields           => $type ne 'check' ? $fields : [],
+            expression       => $type eq 'check' ? $expression : '',
+            deferreable      => $item{'deferrable'},
+            deferred         => $item{'deferred'},
+            reference_table  => $desc->{'reference_table'},
+            reference_fields => $desc->{'reference_fields'},
+            match_type       => $desc->{'match_type'}[0],
+            on_delete_do     => $desc->{'on_delete_do'},
+            on_update_do     => $desc->{'on_update_do'},
+            comments         => [ @comments ],
+        } 
+    }
 
-unsigned     : /unsigned/i { $return = 0 }
+table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')' 
+    { 
+        $return = {
+            type   => 'primary_key',
+            fields => $item[3],
+        }
+    }
+    |
+    /unique/i '(' name_with_opt_quotes(s /,/) ')' 
+    { 
+        $return    =  {
+            type   => 'unique',
+            fields => $item[3],
+        }
+    }
+    |
+    /check/ '(' /(.+)/ ')'
+    {
+        $return        =  {
+            type       => 'check',
+            expression => $item[3],
+        }
+    }
+    |
+    /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) on_delete_do(?) on_update_do(?)
+    {
+        $return              =  {
+            type             => 'foreign_key',
+            fields           => $item[3],
+            reference_table  => $item[6],
+            reference_fields => $item[7][0],
+            match_type       => $item[8][0],
+            on_delete_do     => $item[9][0],
+            on_update_do     => $item[10][0],
+        }
+    }
 
-default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/ 
+deferrable : /not/i /deferrable/i 
     { 
-        $item[2] =~ s/'//g; 
-        $return  =  $item[2];
+        $return = ( $item[1] =~ /not/i ) ? 0 : 1;
     }
 
-auto_inc : /auto_increment/i { 1 } #see data_type
+deferred : /initially/i /(deferred|immediate)/i { $item[2] }
 
-primary_key : /primary/i /key/i { 1 }
+match_type : /match full/i { 'match_full' }
+    |
+    /match partial/i { 'match_partial' }
 
-foreign_key : /foreign/i /key/i { 1 }
+on_delete_do : /on delete/i WORD(s)
+    { $item[2] }
 
-foreign_key_reference : /references/i { 1 }
+on_update_do : /on update/i WORD(s)
+    { $item[2] }
 
-primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
+alter : alter_table table_name /add/i table_constraint ';' 
     { 
-        $return    = { 
-            name   => $item{'index_name'}[0],
-            type   => 'primary_key',
-            fields => $item[4],
-        } 
+        my $table_name = $item[2];
+        my $constraint = $item[4];
+        $constraint->{'type'} = $constraint->{'constraint_type'};
+        push @{ $tables{ $table_name }{'constraints'} }, $constraint;
     }
 
-normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
-    { 
-        $return    = { 
-            name   => $item{'index_name'}[0],
-            type   => 'normal',
-            fields => $item[4],
-        } 
-    }
+alter_table : /alter/i /table/i only(?)
 
-unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
-    { 
-        $return    = { 
-            name   => $item{'index_name'}[0],
-            type   => 'unique',
-            fields => $item[5],
-        } 
-    }
+only : /only/i
+
+create_table : /create/i /table/i
 
-fulltext_index : fulltext key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
+create_index : /create/i /index/i
+
+default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/ 
     { 
-        $return    = { 
-            name   => $item{'index_name'}[0],
-            type   => 'fulltext',
-            fields => $item[5],
-        } 
+        my $val =  $item[2] || '';
+        $val    =~ s/'//g; 
+        $return =  {
+            meta_type => 'default',
+            value     => $val,
+        }
     }
 
 name_with_opt_paren : NAME parens_value_list(s?)
     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 
-fulltext : /fulltext/i { 1 }
-
 unique : /unique/i { 1 }
 
 key : /key/i | /index/i
 
-table_option : /[^\s;]*/ 
+table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
     { 
-        $return = { split /=/, $item[1] }
+        $return = { type => 'inherits', table_name => $item[3] }
     }
+    |
+    /with(out)? oids/i
+    {
+        $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
+    }
+
+SEMICOLON : /\s*;\n?/
 
 WORD : /\w+/
 
@@ -335,6 +553,8 @@ NAME    : "`" /\w+/ "`"
     { $item[2] }
     | /\w+/
     { $item[1] }
+    | /[\$\w]+/
+    { $item[1] }
 
 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
     { $item[1] }
@@ -373,10 +593,10 @@ sub parse {
 
 =pod
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
-Chris Mungall
+Allen Day <allenday@users.sourceforge.net>.
 
 =head1 SEE ALSO