X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FPostgreSQL.pm;h=37f657996b5d2b50bbbcbb4d76a64965463dbf0c;hb=HEAD;hp=e109173738df583cec850531cdd3722fa7f155bf;hpb=99f3fab63b47f624c69f4f4d149cd059de86ce33;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Parser/PostgreSQL.pm b/lib/SQL/Translator/Parser/PostgreSQL.pm
index e109173..37f6579 100644
--- a/lib/SQL/Translator/Parser/PostgreSQL.pm
+++ b/lib/SQL/Translator/Parser/PostgreSQL.pm
@@ -1,25 +1,5 @@
 package SQL::Translator::Parser::PostgreSQL;
 
-# -------------------------------------------------------------------
-# $Id: PostgreSQL.pm,v 1.49 2007-11-09 20:50:17 mwz444 Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2002-4 SQLFairy Authors
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; version 2.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-#
-# 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
-# 02111-1307  USA
-# -------------------------------------------------------------------
-
 =head1 NAME
 
 SQL::Translator::Parser::PostgreSQL - parser for PostgreSQL
@@ -34,41 +14,41 @@ SQL::Translator::Parser::PostgreSQL - parser for PostgreSQL
 
 =head1 DESCRIPTION
 
-The grammar was started from the MySQL parsers.  Here is the description 
+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_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 ] 
+  [ 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 [, ... ] ) 
+    FOREIGN KEY ( column_name [, ... ] )
      REFERENCES reftable [ ( refcolumn [, ... ] ) ]
-      [ MATCH FULL | MATCH PARTIAL ] 
+      [ MATCH FULL | MATCH PARTIAL ]
       [ ON DELETE action ] [ ON UPDATE action ] }
-  [ DEFERRABLE | NOT DEFERRABLE ] 
+  [ DEFERRABLE | NOT DEFERRABLE ]
   [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
 
 Index:
@@ -95,10 +75,10 @@ Alter table:
       RENAME TO new_table
   ALTER TABLE table
       ADD table_constraint_definition
-  ALTER TABLE [ ONLY ] table 
+  ALTER TABLE [ ONLY ] table
           DROP CONSTRAINT constraint { RESTRICT | CASCADE }
   ALTER TABLE table
-          OWNER TO new_owner 
+          OWNER TO new_owner
 
 View table:
 
@@ -107,39 +87,38 @@ View table:
 =cut
 
 use strict;
-use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.49 $ =~ /(\d+)\.(\d+)/;
-$DEBUG   = 0 unless defined $DEBUG;
+use warnings;
 
-use Data::Dumper;
-use Parse::RecDescent;
-use Exporter;
-use base qw(Exporter);
+our $VERSION = '1.62';
 
-@EXPORT_OK = qw(parse);
+our $DEBUG;
+$DEBUG   = 0 unless defined $DEBUG;
 
-# Enable warnings within the Parse::RecDescent module.
-$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
-$::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
-$::RD_HINT   = 1; # Give out hints to help fix problems.
+use Data::Dumper;
+use SQL::Translator::Utils qw/ddl_parser_instance/;
 
-my $parser; # should we do this?  There's no programmic way to 
-            # change the grammar, so I think this is safe.
+use base qw(Exporter);
+our @EXPORT_OK = qw(parse);
 
-$GRAMMAR = q!
+our $GRAMMAR = <<'END_OF_GRAMMAR';
 
-{ my ( %tables, $table_order, $field_order, @table_comments) }
+{ my ( %tables, @views, @triggers, $table_order, $field_order, @table_comments) }
 
 #
 # The "eofile" rule makes the parser fail if any "statement" rule
-# fails.  Otherwise, the first successful match by a "statement" 
+# 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 }
+startrule : statement(s) eofile {
+    {
+        tables => \%tables,
+        views => \@views,
+        triggers => \@triggers,
+    }
+}
 
 eofile : /^\Z/
-   
 
 statement : create
   | comment_on_table
@@ -154,15 +133,23 @@ statement : create
   | connect
   | update
   | set
+  | select
+  | copy
+  | readin_symbol
+  | commit
   | <error>
 
-connect : /^\s*\\\connect.*\n/
+commit : /commit/i ';'
+
+connect : /^\s*\\connect.*\n/
 
 set : /set/i /[^;]*/ ';'
 
-revoke : /revoke/i WORD(s /,/) /on/i TABLE(?) table_name /from/i name_with_opt_quotes(s /,/) ';'
+revoke : /revoke/i WORD(s /,/) /on/i TABLE(?) table_id /from/i NAME(s /,/) ';'
     {
-        my $table_name = $item{'table_name'};
+        my $table_info  = $item{'table_id'};
+        my $schema_name = $table_info->{'schema_name'};
+        my $table_name  = $table_info->{'table_name'};
         push @{ $tables{ $table_name }{'permissions'} }, {
             type       => 'revoke',
             actions    => $item[2],
@@ -170,9 +157,14 @@ revoke : /revoke/i WORD(s /,/) /on/i TABLE(?) table_name /from/i name_with_opt_q
         }
     }
 
-grant : /grant/i WORD(s /,/) /on/i TABLE(?) table_name /to/i name_with_opt_quotes(s /,/) ';'
+revoke : /revoke/i WORD(s /,/) /on/i SCHEMA(?) schema_name /from/i NAME(s /,/) ';'
+    { 1 }
+
+grant : /grant/i WORD(s /,/) /on/i TABLE(?) table_id /to/i NAME(s /,/) ';'
     {
-        my $table_name = $item{'table_name'};
+        my $table_info  = $item{'table_id'};
+        my $schema_name = $table_info->{'schema_name'};
+        my $table_name  = $table_info->{'table_name'};
         push @{ $tables{ $table_name }{'permissions'} }, {
             type       => 'grant',
             actions    => $item[2],
@@ -180,27 +172,35 @@ grant : /grant/i WORD(s /,/) /on/i TABLE(?) table_name /to/i name_with_opt_quote
         }
     }
 
+grant : /grant/i WORD(s /,/) /on/i SCHEMA(?) schema_name /to/i NAME(s /,/) ';'
+    { 1 }
+
 drop : /drop/i /[^;]*/ ';'
 
 string :
-   /'(\\.|''|[^\\\'])*'/ 
+   /'(\.|''|[^\\'])*'/
 
 nonstring : /[^;\'"]+/
 
-statement_body : (string | nonstring)(s?)
+statement_body : string | nonstring
 
-insert : /insert/i statement_body ';'
+insert : /insert/i statement_body(s?) ';'
 
-update : /update/i statement_body ';'
+update : /update/i statement_body(s?) ';'
 
 #
 # Create table.
 #
-create : create_table table_name '(' create_definition(s? /,/) ')' table_option(s?) ';'
+create : CREATE temporary(?) TABLE table_id '(' 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 $table_info  = $item{'table_id'};
+        my $schema_name = $table_info->{'schema_name'};
+        my $table_name  = $table_info->{'table_name'};
+        $tables{ $table_name }{'order'}       = ++$table_order;
+        $tables{ $table_name }{'schema_name'} = $schema_name;
+        $tables{ $table_name }{'table_name'}  = $table_name;
+
+        $tables{ $table_name }{'temporary'} = $item[2][0];
 
         if ( @table_comments ) {
             $tables{ $table_name }{'comments'} = [ @table_comments ];
@@ -208,12 +208,12 @@ create : create_table table_name '(' create_definition(s? /,/) ')' table_option(
         }
 
         my @constraints;
-        for my $definition ( @{ $item[4] } ) {
+        for my $definition ( @{ $item[6] } ) {
             if ( $definition->{'supertype'} eq 'field' ) {
                 my $field_name = $definition->{'name'};
-                $tables{ $table_name }{'fields'}{ $field_name } = 
+                $tables{ $table_name }{'fields'}{ $field_name } =
                     { %$definition, order => $field_order++ };
-				
+
                 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
                     $constraint->{'fields'} = [ $field_name ];
                     push @{ $tables{ $table_name }{'constraints'} },
@@ -228,26 +228,68 @@ create : create_table table_name '(' create_definition(s? /,/) ')' table_option(
             }
         }
 
-        for my $option ( @{ $item[6] } ) {
-            $tables{ $table_name }{'table_options(s?)'}{ $option->{'type'} } = 
+        for my $option ( @{ $item[8] } ) {
+            $tables{ $table_name }{'table_options(s?)'}{ $option->{'type'} } =
                 $option;
         }
 
         1;
     }
 
-create : CREATE unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
+create : CREATE unique(?) /(index|key)/i index_name /on/i table_id using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
     {
-        push @{ $tables{ $item{'table_name'} }{'indices'} },
+        my $table_info  = $item{'table_id'};
+        my $schema_name = $table_info->{'schema_name'};
+        my $table_name  = $table_info->{'table_name'};
+        push @{ $tables{ $table_name }{'indices'} },
             {
                 name      => $item{'index_name'},
                 supertype => $item{'unique'}[0] ? 'constraint' : 'index',
                 type      => $item{'unique'}[0] ? 'unique'     : 'normal',
                 fields    => $item[9],
-                method    => $item{'using_method'}[0],
+                method    => $item{'using_method(?)'}[0],
+                where     => $item{'where_predicate(?)'}[0],
             }
         ;
+    }
 
+create : CREATE or_replace(?) temporary(?) VIEW view_id view_fields(?) /AS/i view_target ';'
+    {
+        push @views, {
+            schema_name  => $item{view_id}{schema_name},
+            view_name    => $item{view_id}{view_name},
+            sql          => $item{view_target},
+            fields       => $item[6],
+            is_temporary => $item[3][0],
+        }
+    }
+
+trigger_name : NAME
+
+trigger_scope : /FOR/i /EACH/i /(ROW|STATEMENT)/i { $return = lc $1 }
+
+before_or_after : /(before|after)/i { $return = lc $1 }
+
+trigger_action : /.+/
+
+database_event : /insert|update|delete/i
+database_events : database_event(s /OR/)
+
+create : CREATE /TRIGGER/i trigger_name before_or_after database_events /ON/i table_id trigger_scope(?) trigger_action
+    {
+        # Hack to pass roundtrip tests which have trigger statements terminated by double semicolon
+        # and expect the returned data to have the same
+        my $action = $item{trigger_action};
+        $action =~ s/;$//;
+
+        push @triggers, {
+            name => $item{trigger_name},
+            perform_action_when => $item{before_or_after},
+            database_events => $item{database_events},
+            on_table => $item{table_id}{table_name},
+            scope => $item{'trigger_scope(?)'}[0],
+            action => $action,
+        }
     }
 
 #
@@ -264,8 +306,8 @@ create_definition : field
     | table_constraint
     | <error>
 
-comment : /^\s*(?:#|-{2})(.*)\n/ 
-    { 
+comment : /^\s*(?:#|-{2})(.*)\n/
+    {
         my $comment =  $item[1];
         $comment    =~ s/^\s*(#|-*)\s*//;
         $comment    =~ s/\s*$//;
@@ -273,9 +315,12 @@ comment : /^\s*(?:#|-{2})(.*)\n/
         push @table_comments, $comment;
     }
 
-comment_on_table : /comment/i /on/i /table/i table_name /is/i comment_phrase ';'
+comment_on_table : /comment/i /on/i /table/i table_id /is/i comment_phrase ';'
     {
-        push @{ $tables{ $item{'table_name'} }{'comments'} }, $item{'comment_phrase'};
+        my $table_info  = $item{'table_id'};
+        my $schema_name = $table_info->{'schema_name'};
+        my $table_name  = $table_info->{'table_name'};
+        push @{ $tables{ $table_name }{'comments'} }, $item{'comment_phrase'};
     }
 
 comment_on_column : /comment/i /on/i /column/i column_name /is/i comment_phrase ';'
@@ -283,7 +328,7 @@ comment_on_column : /comment/i /on/i /column/i column_name /is/i comment_phrase
         my $table_name = $item[4]->{'table'};
         my $field_name = $item[4]->{'field'};
         if ($tables{ $table_name }{'fields'}{ $field_name } ) {
-          push @{ $tables{ $table_name }{'fields'}{ $field_name }{'comments'} }, 
+          push @{ $tables{ $table_name }{'fields'}{ $field_name }{'comments'} },
               $item{'comment_phrase'};
         }
         else {
@@ -320,22 +365,7 @@ column_name : NAME '.' NAME
 
 comment_phrase : /null/i
     { $return = 'NULL' }
-
-comment_phrase : /'/ comment_phrase_unquoted(s) /'/
-    { my $phrase = join(' ', @{ $item[2] });
-      $return = $phrase}
-
-# [cjm TODO: double-single quotes in a comment_phrase]
-comment_phrase_unquoted : /[^\']*/
-    { $return = $item[1] }
-
-
-xxxcomment_phrase : /'.*?'|NULL/ 
-    { 
-        my $val = $item[1] || '';
-        $val =~ s/^'|'$//g;
-        $return = $val;
-    }
+    | SQSTRING
 
 field : field_comment(s?) field_name data_type field_meta(s?) field_comment(s?)
     {
@@ -360,7 +390,7 @@ field : field_comment(s?) field_name data_type field_meta(s?) field_comment(s?)
 
         $return = {
             supertype         => 'field',
-            name              => $item{'field_name'}, 
+            name              => $item{'field_name'},
             data_type         => $item{'data_type'}{'type'},
             size              => $item{'data_type'}{'size'},
             is_nullable       => $is_nullable,
@@ -369,12 +399,12 @@ field : field_comment(s?) field_name data_type field_meta(s?) field_comment(s?)
             comments          => [ @comments ],
             is_primary_key    => $is_pk || 0,
             is_auto_increment => $item{'data_type'}{'is_auto_increment'},
-        } 
+        }
     }
     | <error>
 
-field_comment : /^\s*(?:#|-{2})(.*)\n/ 
-    { 
+field_comment : /^\s*(?:#|-{2})(.*)\n/
+    {
         my $comment =  $item[1];
         $comment    =~ s/^\s*(#|-*)\s*//;
         $comment    =~ s/\s*$//;
@@ -384,6 +414,9 @@ field_comment : /^\s*(?:#|-{2})(.*)\n/
 field_meta : default_val
     | column_constraint
 
+view_fields : '(' field_name(s /,/) ')'
+    { $return = join (',', @{$item[2]} ) }
+
 column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
     {
         my $desc       = $item{'column_constraint_type'};
@@ -403,10 +436,10 @@ column_constraint : constraint_name(?) column_constraint_type deferrable(?) defe
             match_type       => $desc->{'match_type'},
             on_delete        => $desc->{'on_delete'} || $desc->{'on_delete_do'},
             on_update        => $desc->{'on_update'} || $desc->{'on_update_do'},
-        } 
+        }
     }
 
-constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
+constraint_name : /constraint/i NAME { $item[2] }
 
 column_constraint_type : /not null/i { $return = { type => 'not_null' } }
     |
@@ -416,14 +449,17 @@ column_constraint_type : /not null/i { $return = { type => 'not_null' } }
     /unique/i
         { $return = { type => 'unique' } }
     |
-    /primary key/i 
+    /primary key/i
         { $return = { type => 'primary_key' } }
     |
-    /check/i '(' /[^)]+/ ')' 
+    /check/i '(' /[^)]+/ ')'
         { $return = { type => 'check', expression => $item[3] } }
     |
-    /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
+    /references/i table_id parens_word_list(?) match_type(?) key_action(s?)
     {
+        my $table_info  = $item{'table_id'};
+        my $schema_name = $table_info->{'schema_name'};
+        my $table_name  = $table_info->{'table_name'};
         my ( $on_delete, $on_update );
         for my $action ( @{ $item[5] || [] } ) {
             $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
@@ -432,7 +468,7 @@ column_constraint_type : /not null/i { $return = { type => 'not_null' } }
 
         $return              =  {
             type             => 'foreign_key',
-            reference_table  => $item[2],
+            reference_table  => $table_name,
             reference_fields => $item[3][0],
             match_type       => $item[4][0],
             on_delete        => $on_delete,
@@ -440,25 +476,50 @@ column_constraint_type : /not null/i { $return = { type => 'not_null' } }
         }
     }
 
-table_name : name_with_opt_quotes
+table_id : schema_qualification(?) NAME {
+    $return = { schema_name => $item[1][0], table_name => $item[2] }
+}
+
+view_id : schema_qualification(?) NAME {
+    $return = { schema_name => $item[1][0], view_name => $item[2] }
+}
+
+view_target : /select|with/i /[^;]+/ {
+    $return = "$item[1] $item[2]";
+}
+
+# SELECT views _may_ support outer parens, and we used to produce
+# such sql, although non-standard. Use ugly lookeahead to parse
+view_target : '('   /select/i    / [^;]+ (?= \) ) /x    ')'    {
+    $return = "$item[2] $item[3]"
+}
+
+view_target_spec :
 
-field_name : name_with_opt_quotes
+schema_qualification : NAME '.'
 
-name_with_opt_quotes : double_quote(?) NAME double_quote(?) { $item[2] }
+schema_name : NAME
+
+field_name : NAME
 
 double_quote: /"/
 
-index_name : WORD
+index_name : NAME
+
+array_indicator : '[' ']'
+    { $return = $item[1].$item[2] }
 
-data_type : pg_data_type parens_value_list(?)
-    { 
+data_type : pg_data_type parens_value_list(?) array_indicator(?)
+    {
         my $data_type = $item[1];
 
+        $data_type->{type} .= $item[3][0] if $item[3][0];
+
         #
         # We can deduce some sizes from the data type's name.
         #
-        if ( my $size = $item[2][0] ) {
-            $data_type->{'size'} = $size;
+        if ( my @size = @{$item[2]} ) {
+            $data_type->{'size'} = (@size == 1 ? $size[0] : \@size);
         }
 
         $return  = $data_type;
@@ -466,17 +527,17 @@ data_type : pg_data_type parens_value_list(?)
 
 pg_data_type :
     /(bigint|int8)/i
-        { 
-            $return = { 
+        {
+            $return = {
                 type => 'integer',
                 size => 20,
             };
         }
     |
     /(smallint|int2)/i
-        { 
+        {
             $return = {
-                type => 'integer', 
+                type => 'integer',
                 size => 5,
             };
         }
@@ -487,94 +548,100 @@ pg_data_type :
         }
     |
     /(integer|int4?)/i # interval must come before this
-        { 
+        {
             $return = {
-                type => 'integer', 
+                type => 'integer',
                 size => 10,
             };
         }
-    |    
+    |
     /(real|float4)/i
-        { 
+        {
             $return = {
-                type => 'real', 
+                type => 'real',
                 size => 10,
             };
         }
     |
     /(double precision|float8?)/i
-        { 
+        {
             $return = {
-                type => 'float', 
+                type => 'float',
                 size => 20,
-            }; 
+            };
         }
     |
     /(bigserial|serial8)/i
-        { 
-            $return = { 
-                type              => 'integer', 
-                size              => 20, 
+        {
+            $return = {
+                type              => 'integer',
+                size              => 20,
                 is_auto_increment => 1,
             };
         }
     |
     /serial4?/i
-        { 
-            $return = { 
+        {
+            $return = {
                 type              => 'integer',
-                size              => 11, 
+                size              => 11,
                 is_auto_increment => 1,
             };
         }
     |
     /(bit varying|varbit)/i
-        { 
+        {
             $return = { type => 'varbit' };
         }
     |
     /character varying/i
-        { 
+        {
             $return = { type => 'varchar' };
         }
     |
     /char(acter)?/i
-        { 
+        {
             $return = { type => 'char' };
         }
     |
     /bool(ean)?/i
-        { 
+        {
             $return = { type => 'boolean' };
         }
     |
     /bytea/i
-        { 
+        {
             $return = { type => 'bytea' };
         }
     |
-    /(timestamptz|timestamp)(?:\(\d\))?( with(out)? time zone)?/i
-        { 
-            $return = { type => 'timestamp' };
+    / ( timestamp (?:tz)? ) (?: \( \d \) )? ( \s with (?:out)? \s time \s zone )? /ix
+        {
+            $return = { type => 'timestamp' . ($2||'') };
+        }
+    |
+    / ( time (?:tz)? ) (?: \( \d \) )? ( \s with (?:out)? \s time \s zone )? /ix
+        {
+            $return = { type => 'time' . ($2||'') };
         }
     |
     /text/i
-        { 
-            $return = { 
+        {
+            $return = {
                 type => 'text',
                 size => 64_000,
             };
         }
     |
-    /(bit|box|cidr|circle|date|inet|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|timetz|time|varchar)/i
-        { 
+    /(bit|box|cidr|circle|date|inet|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|varchar|json|hstore|uuid)/i
+        {
             $return = { type => $item[1] };
         }
 
 parens_value_list : '(' VALUE(s /,/) ')'
     { $item[2] }
 
-parens_word_list : '(' WORD(s /,/) ')'
+
+parens_word_list : '(' NAME(s /,/) ')'
     { $item[2] }
 
 field_size : '(' num_range ')' { $item{'num_range'} }
@@ -593,7 +660,7 @@ table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrab
         my @comments   = ( @{ $item[1] }, @{ $item[-1] } );
 
         $return              =  {
-            name             => $item{'constraint_name'}[0] || '',
+            name             => $item[2][0] || '',
             supertype        => 'constraint',
             type             => $type,
             fields           => $type ne 'check' ? $fields : [],
@@ -602,30 +669,30 @@ table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrab
             deferred         => $item{'deferred'},
             reference_table  => $desc->{'reference_table'},
             reference_fields => $desc->{'reference_fields'},
-            match_type       => $desc->{'match_type'}[0],
+            match_type       => $desc->{'match_type'},
             on_delete        => $desc->{'on_delete'} || $desc->{'on_delete_do'},
             on_update        => $desc->{'on_update'} || $desc->{'on_update_do'},
             comments         => [ @comments ],
-        } 
+        }
     }
 
-table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')' 
-    { 
+table_constraint_type : /primary key/i '(' NAME(s /,/) ')'
+    {
         $return = {
             type   => 'primary_key',
             fields => $item[3],
         }
     }
     |
-    /unique/i '(' name_with_opt_quotes(s /,/) ')' 
-    { 
+    /unique/i '(' NAME(s /,/) ')'
+    {
         $return    =  {
             type   => 'unique',
             fields => $item[3],
         }
     }
     |
-    /check/i '(' /[^)]+/ ')' 
+    /check/i '(' /[^)]+/ ')'
     {
         $return        =  {
             type       => 'check',
@@ -633,19 +700,19 @@ table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')'
         }
     }
     |
-    /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
+    /foreign key/i '(' NAME(s /,/) ')' /references/i table_id parens_word_list(?) match_type(?) key_action(s?)
     {
         my ( $on_delete, $on_update );
         for my $action ( @{ $item[9] || [] } ) {
             $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
             $on_update = $action->{'action'} if $action->{'type'} eq 'update';
         }
-        
+
         $return              =  {
             supertype        => 'constraint',
             type             => 'foreign_key',
             fields           => $item[3],
-            reference_table  => $item[6],
+            reference_table  => $item[6]->{'table_name'},
             reference_fields => $item[7][0],
             match_type       => $item[8][0],
             on_delete     => $on_delete || '',
@@ -653,32 +720,30 @@ table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')'
         }
     }
 
-deferrable : not(?) /deferrable/i 
-    { 
+deferrable : not(?) /deferrable/i
+    {
         $return = ( $item[1] =~ /not/i ) ? 0 : 1;
     }
 
 deferred : /initially/i /(deferred|immediate)/i { $item[2] }
 
-match_type : /match full/i { 'match_full' }
-    |
-    /match partial/i { 'match_partial' }
+match_type : /match/i /partial|full|simple/i { $item[2] }
 
-key_action : key_delete 
+key_action : key_delete
     |
     key_update
 
 key_delete : /on delete/i key_mutation
-    { 
-        $return = { 
+    {
+        $return = {
             type   => 'delete',
             action => $item[2],
         };
     }
 
 key_update : /on update/i key_mutation
-    { 
-        $return = { 
+    {
+        $return = {
             type   => 'update',
             action => $item[2],
         };
@@ -694,32 +759,32 @@ key_mutation : /no action/i { $return = 'no_action' }
     |
     /set default/i { $return = 'set default' }
 
-alter : alter_table table_name add_column field ';' 
-    { 
+alter : alter_table table_id add_column field ';'
+    {
         my $field_def = $item[4];
-        $tables{ $item[2] }{'fields'}{ $field_def->{'name'} } = {
+        $tables{ $item[2]->{'table_name'} }{'fields'}{ $field_def->{'name'} } = {
             %$field_def, order => $field_order++
         };
         1;
     }
 
-alter : alter_table table_name ADD table_constraint ';' 
-    { 
-        my $table_name = $item[2];
+alter : alter_table table_id ADD table_constraint ';'
+    {
+        my $table_name = $item[2]->{'table_name'};
         my $constraint = $item[4];
         push @{ $tables{ $table_name }{'constraints'} }, $constraint;
         1;
     }
 
-alter : alter_table table_name drop_column NAME restrict_or_cascade(?) ';' 
+alter : alter_table table_id drop_column NAME restrict_or_cascade(?) ';'
     {
-        $tables{ $item[2] }{'fields'}{ $item[4] }{'drop'} = 1;
+        $tables{ $item[2]->{'table_name'} }{'fields'}{ $item[4] }{'drop'} = 1;
         1;
     }
 
-alter : alter_table table_name alter_column NAME alter_default_val ';' 
+alter : alter_table table_id alter_column NAME alter_default_val ';'
     {
-        $tables{ $item[2] }{'fields'}{ $item[4] }{'default'} = 
+        $tables{ $item[2]->{'table_name'} }{'fields'}{ $item[4] }{'default'} =
             $item[5]->{'value'};
         1;
     }
@@ -727,49 +792,59 @@ alter : alter_table table_name alter_column NAME alter_default_val ';'
 #
 # These will just parse for now but won't affect the structure. - ky
 #
-alter : alter_table table_name /rename/i /to/i NAME ';'
+alter : alter_table table_id /rename/i /to/i NAME ';'
+    { 1 }
+
+alter : alter_table table_id alter_column NAME SET /statistics/i INTEGER ';'
     { 1 }
 
-alter : alter_table table_name alter_column NAME SET /statistics/i INTEGER ';' 
+alter : alter_table table_id alter_column NAME SET /storage/i storage_type ';'
     { 1 }
 
-alter : alter_table table_name alter_column NAME SET /storage/i storage_type ';'
+alter : alter_table table_id rename_column NAME /to/i NAME ';'
     { 1 }
 
-alter : alter_table table_name rename_column NAME /to/i NAME ';'
+alter : alter_table table_id DROP /constraint/i NAME restrict_or_cascade ';'
     { 1 }
 
-alter : alter_table table_name DROP /constraint/i NAME restrict_or_cascade ';'
+alter : alter_table table_id /owner/i /to/i NAME ';'
     { 1 }
 
-alter : alter_table table_name /owner/i /to/i NAME ';'
+alter : alter_sequence NAME /owned/i /by/i column_name ';'
     { 1 }
 
 storage_type : /(plain|external|extended|main)/i
 
-alter_default_val : SET default_val 
-    { 
-        $return = { value => $item[2]->{'value'} } 
+temporary : /temp(orary)?\b/i
+  {
+    1;
+  }
+
+or_replace : /or replace/i
+
+alter_default_val : SET default_val
+    {
+        $return = { value => $item[2]->{'value'} }
+    }
+    | DROP DEFAULT
+    {
+        $return = { value => undef }
     }
-    | DROP DEFAULT 
-    { 
-        $return = { value => undef } 
-    } 
 
 #
-# This is a little tricky to get right, at least WRT to making the 
+# This is a little tricky to get right, at least WRT to making the
 # tests pass.  The problem is that the constraints are stored just as
 # a list (no name access), and the tests expect the constraints in a
-# particular order.  I'm going to leave the rule but disable the code 
+# particular order.  I'm going to leave the rule but disable the code
 # for now. - ky
 #
-alter : alter_table table_name alter_column NAME alter_nullable ';'
+alter : alter_table table_id alter_column NAME alter_nullable ';'
     {
-#        my $table_name  = $item[2];
+#        my $table_name  = $item[2]->{'table_name'};
 #        my $field_name  = $item[4];
 #        my $is_nullable = $item[5]->{'is_nullable'};
 #
-#        $tables{ $table_name }{'fields'}{ $field_name }{'is_nullable'} = 
+#        $tables{ $table_name }{'fields'}{ $field_name }{'is_nullable'} =
 #            $is_nullable;
 #
 #        if ( $is_nullable ) {
@@ -780,8 +855,8 @@ alter : alter_table table_name alter_column NAME alter_nullable ';'
 #            };
 #        }
 #        else {
-#            for my $i ( 
-#                0 .. $#{ $tables{ $table_name }{'constraints'} || [] } 
+#            for my $i (
+#                0 .. $#{ $tables{ $table_name }{'constraints'} || [] }
 #            ) {
 #                my $c = $tables{ $table_name }{'constraints'}[ $i ] or next;
 #                my $fields = join( '', @{ $c->{'fields'} || [] } ) or next;
@@ -795,13 +870,13 @@ alter : alter_table table_name alter_column NAME alter_nullable ';'
         1;
     }
 
-alter_nullable : SET not_null 
-    { 
-        $return = { is_nullable => 0 } 
+alter_nullable : SET not_null
+    {
+        $return = { is_nullable => 0 }
     }
     | DROP not_null
-    { 
-        $return = { is_nullable => 1 } 
+    {
+        $return = { is_nullable => 1 }
     }
 
 not_null : /not/i /null/i
@@ -812,15 +887,35 @@ add_column : ADD COLUMN(?)
 
 alter_table : ALTER TABLE ONLY(?)
 
+alter_sequence : ALTER SEQUENCE
+
 drop_column : DROP COLUMN(?)
 
 alter_column : ALTER COLUMN(?)
 
 rename_column : /rename/i COLUMN(?)
 
-restrict_or_cascade : /restrict/i | 
+restrict_or_cascade : /restrict/i |
     /cascade/i
 
+# Handle functions that can be called
+select : SELECT select_function ';'
+    { 1 }
+
+# Read the setval function but don't do anything with it because this parser
+# isn't handling sequences
+select_function : schema_qualification(?) /setval/i '(' VALUE /,/ VALUE /,/ /(true|false)/i ')'
+    { 1 }
+
+# Skipping all COPY commands
+copy : COPY WORD /[^;]+/ ';' { 1 }
+    { 1 }
+
+# The "\." allows reading in from STDIN but this isn't needed for schema
+# creation, so it is skipped.
+readin_symbol : '\.'
+    {1}
+
 #
 # End basically useless stuff. - ky
 #
@@ -829,10 +924,10 @@ create_table : CREATE TABLE
 
 create_index : CREATE /index/i
 
-default_val  : DEFAULT /(\d+|'[^']*'|\w+\(.*?\))|\w+/
-    { 
-        my $val =  defined $item[2] ? $item[2] : '';
-        $val    =~ s/^'|'$//g; 
+default_val  : DEFAULT DEFAULT_VALUE ( '::' data_type )(?)
+    {
+        my $val =  $item[2];
+        $val =~ s/^\((\d+)\)\z/$1/; # for example (0)::smallint
         $return =  {
             supertype => 'constraint',
             type      => 'default',
@@ -840,7 +935,7 @@ default_val  : DEFAULT /(\d+|'[^']*'|\w+\(.*?\))|\w+/
         }
     }
     | /null/i
-    { 
+    {
         $return =  {
             supertype => 'constraint',
             type      => 'default',
@@ -848,6 +943,11 @@ default_val  : DEFAULT /(\d+|'[^']*'|\w+\(.*?\))|\w+/
         }
     }
 
+DEFAULT_VALUE : VALUE
+    | /\w+\(.*\)/
+    | /\w+/
+    | /\(\d+\)/
+
 name_with_opt_paren : NAME parens_value_list(s?)
     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 
@@ -855,8 +955,8 @@ unique : /unique/i { 1 }
 
 key : /key/i | /index/i
 
-table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
-    { 
+table_option : /inherits/i '(' NAME(s /,/) ')'
+    {
         $return = { type => 'inherits', table_name => $item[3] }
     }
     |
@@ -881,8 +981,18 @@ COLUMN : /column/i
 
 TABLE : /table/i
 
+VIEW : /view/i
+
+SCHEMA : /schema/i
+
 SEMICOLON : /\s*;\n?/
 
+SEQUENCE : /sequence/i
+
+SELECT : /select/i
+
+COPY : /copy/i
+
 INTEGER : /\d+/
 
 WORD : /\w+/
@@ -893,54 +1003,61 @@ COMMA : ','
 
 SET : /set/i
 
-NAME    : "`" /\w+/ "`"
-    { $item[2] }
+NAME : DQSTRING
     | /\w+/
-    { $item[1] }
-    | /[\$\w]+/
-    { $item[1] }
-
-VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
-    { $item[1] }
-    | /'.*?'/   # XXX doesn't handle embedded quotes
-    { $item[1] }
+
+DQSTRING : '"' <skip: ''> /((?:[^"]|"")+)/ '"'
+    { ($return = $item[3]) =~ s/""/"/g; }
+
+SQSTRING : "'" <skip: ''> /((?:[^']|'')*)/ "'"
+    { ($return = $item[3]) =~ s/''/'/g }
+
+DOLLARSTRING : /\$[^\$]*\$/ <skip: ''> /.*?(?=\Q$item[1]\E)/s "$item[1]"
+    { $return = $item[3]; }
+
+VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/
+    | SQSTRING
+    | DOLLARSTRING
     | /null/i
     { 'NULL' }
 
-!;
+END_OF_GRAMMAR
 
-# -------------------------------------------------------------------
 sub parse {
     my ( $translator, $data ) = @_;
-    $parser ||= Parse::RecDescent->new($GRAMMAR);
 
-    $::RD_TRACE  = $translator->trace ? 1 : undef;
-    $DEBUG       = $translator->debug;
+    # Enable warnings within the Parse::RecDescent module.
+    local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
+    local $::RD_WARN   = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
+    local $::RD_HINT   = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.
 
-    unless (defined $parser) {
-        return $translator->error("Error instantiating Parse::RecDescent ".
-            "instance: Bad grammer");
-    }
+    local $::RD_TRACE  = $translator->trace ? 1 : undef;
+    local $DEBUG       = $translator->debug;
+
+    my $parser = ddl_parser_instance('PostgreSQL');
 
     my $result = $parser->startrule($data);
     die "Parse failed.\n" unless defined $result;
     warn Dumper($result) if $DEBUG;
 
     my $schema = $translator->schema;
-    my @tables = sort { 
-        ( $result->{ $a }{'order'} || 0 ) <=> ( $result->{ $b }{'order'} || 0 )
-    } keys %{ $result };
+    my @tables = sort {
+        ( $result->{tables}{ $a }{'order'} || 0 ) <=> ( $result->{tables}{ $b }{'order'} || 0 )
+    } keys %{ $result->{tables} };
 
     for my $table_name ( @tables ) {
-        my $tdata =  $result->{ $table_name };
-        my $table =  $schema->add_table( 
-            name  => $tdata->{'table_name'},
+        my $tdata =  $result->{tables}{ $table_name };
+        my $table =  $schema->add_table(
+            #schema => $tdata->{'schema_name'},
+            name   => $tdata->{'table_name'},
         ) or die "Couldn't create table '$table_name': " . $schema->error;
 
+        $table->extra(temporary => 1) if $tdata->{'temporary'};
+
         $table->comments( $tdata->{'comments'} );
 
-        my @fields = sort { 
-            $tdata->{'fields'}{ $a }{'order'} 
+        my @fields = sort {
+            $tdata->{'fields'}{ $a }{'order'}
             <=>
             $tdata->{'fields'}{ $b }{'order'}
         } keys %{ $tdata->{'fields'} };
@@ -968,11 +1085,15 @@ sub parse {
         }
 
         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
+            my @options = ();
+            push @options, { using => $idata->{'method'} } if $idata->{method};
+            push @options, { where => $idata->{'where'} }  if $idata->{where};
             my $index  =  $table->add_index(
-                name   => $idata->{'name'},
-                type   => uc $idata->{'type'},
-                fields => $idata->{'fields'},
-            ) or die $table->error;
+                name    => $idata->{'name'},
+                type    => uc $idata->{'type'},
+                fields  => $idata->{'fields'},
+                options => \@options
+            ) or die $table->error . ' ' . $table->name;
         }
 
         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
@@ -987,11 +1108,27 @@ sub parse {
                 on_update        => $cdata->{'on_update'} || $cdata->{'on_update_do'},
                 expression       => $cdata->{'expression'},
             ) or die "Can't add constraint of type '" .
-                $cdata->{'type'} .  "' to table '" . $table->name . 
+                $cdata->{'type'} .  "' to table '" . $table->name .
                 "': " . $table->error;
         }
     }
 
+    for my $vinfo (@{$result->{views}}) {
+      my $sql = $vinfo->{sql};
+      $sql =~ s/\A\s+|\s+\z//g;
+      my $view = $schema->add_view (
+        name => $vinfo->{view_name},
+        sql => $sql,
+        fields => $vinfo->{fields},
+      );
+
+      $view->extra ( temporary => 1 ) if $vinfo->{is_temporary};
+    }
+
+    for my $trigger (@{ $result->{triggers} }) {
+        $schema->add_trigger( %$trigger );
+    }
+
     return 1;
 }
 
@@ -999,7 +1136,7 @@ sub parse {
 
 # -------------------------------------------------------------------
 # Rescue the drowning and tie your shoestrings.
-# Henry David Thoreau 
+# Henry David Thoreau
 # -------------------------------------------------------------------
 
 =pod