X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FOracle.pm;h=4da09fb9b492e711de6eb8a899313bddeb43d4f9;hb=bdf60588bb1e35e284bdc02c43d0ffe691994465;hp=ddb6b3f3471cae9a24f3279c8fd08997534b7f0e;hpb=2e0b976328a216356ec080900c39bd4c4b4d13a9;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Parser/Oracle.pm b/lib/SQL/Translator/Parser/Oracle.pm
index ddb6b3f..4da09fb 100644
--- a/lib/SQL/Translator/Parser/Oracle.pm
+++ b/lib/SQL/Translator/Parser/Oracle.pm
@@ -1,23 +1,5 @@
 package SQL::Translator::Parser::Oracle;
 
-# -------------------------------------------------------------------
-# Copyright (C) 2002-2009 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::Oracle - parser for Oracle
@@ -37,7 +19,7 @@ From http://www.ss64.com/ora/table_c.html:
  CREATE [GLOBAL TEMPORARY] TABLE [schema.]table (tbl_defs,...)
      [ON COMMIT {DELETE|PRESERVE} ROWS]
          [storage_options | CLUSTER cluster_name (col1, col2,... )
-            | ORGANIZATION {HEAP [storage_options] 
+            | ORGANIZATION {HEAP [storage_options]
             | INDEX idx_organized_tbl_clause}]
                [LOB_storage_clause][varray_clause][nested_storage_clause]
                    partitioning_options
@@ -82,46 +64,43 @@ Column Constraints
    CONSTRAINT constrnt_name REFERENCES [schema.]table[(column)]
       [ON DELETE {CASCADE|SET NULL}] constrnt_state
 
-constrnt_state   
+constrnt_state
     [[NOT] DEFERRABLE] [INITIALLY {IMMEDIATE|DEFERRED}]
        [RELY | NORELY] [USING INDEX using_index_clause]
           [ENABLE|DISABLE] [VALIDATE|NOVALIDATE]
               [EXCEPTIONS INTO [schema.]table]
 
-Note that probably not all of the above syntax is supported, but the grammar 
+Note that probably not all of the above syntax is supported, but the grammar
 was altered to better handle the syntax created by DDL::Oracle.
 
 =cut
 
 use strict;
-use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+use warnings;
+
+our $VERSION = '1.59';
+
+our $DEBUG;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
-use Parse::RecDescent;
-use Exporter;
-use base qw(Exporter);
-
-@EXPORT_OK = qw(parse);
+use SQL::Translator::Utils qw/ddl_parser_instance/;
 
-# 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 base qw(Exporter);
+our @EXPORT_OK = qw(parse);
 
-$GRAMMAR = q`
+our $GRAMMAR = <<'END_OF_GRAMMAR';
 
 { my ( %tables, %indices, %constraints, $table_order, @table_comments, %views, $view_order, %procedures, $proc_order ) }
 
 #
 # 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 
-    { 
+startrule : statement(s) eofile
+    {
         $return = {
             tables      => \%tables,
             indices     => \%indices,
@@ -134,7 +113,7 @@ startrule : statement(s) eofile
 eofile : /^\Z/
 
 statement : remark
-	| run
+   | run
     | prompt
     | create
     | table_comment
@@ -168,13 +147,13 @@ create : create_table table_name '(' create_definition(s /,/) ')' table_option(s
         for my $definition ( @{ $item[4] } ) {
             if ( $definition->{'type'} eq 'field' ) {
                 my $field_name = $definition->{'name'};
-                $tables{ $table_name }{'fields'}{ $field_name } = 
+                $tables{ $table_name }{'fields'}{ $field_name } =
                     { %$definition, order => $i };
                 $i++;
-				
+
                 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
                     $constraint->{'fields'} = [ $field_name ];
-                    push @{ $tables{ $table_name }{'constraints'} }, 
+                    push @{ $tables{ $table_name }{'constraints'} },
                         $constraint;
                 }
             }
@@ -214,42 +193,42 @@ create : create_index index_name /on/i table_name index_expr table_option(?) ';'
     }
 
 index_expr: parens_word_list
-	{ $item[1] }
-	| '(' WORD parens_word_list ')'
-	{
-		my $arg_list = join(",", @{$item[3]});
-		$return = "$item[2]($arg_list)";
-	}
+   { $item[1] }
+   | '(' WORD parens_word_list ')'
+   {
+      my $arg_list = join(",", @{$item[3]});
+      $return = "$item[2]($arg_list)";
+   }
 
 create : /create/i /or replace/i /procedure/i table_name not_end m#^/$#im
-	{
-		@table_comments = ();
+   {
+      @table_comments = ();
         my $proc_name = $item[4];
         # Hack to strip owner from procedure name
         $proc_name =~ s#.*\.##;
         my $owner = '';
         my $sql = "$item[1] $item[2] $item[3] $item[4] $item[5]";
-        
+
         $procedures{ $proc_name }{'order'}  = ++$proc_order;
         $procedures{ $proc_name }{'name'}   = $proc_name;
         $procedures{ $proc_name }{'owner'}  = $owner;
         $procedures{ $proc_name }{'sql'}    = $sql;
-	}
+   }
 
 not_end: m#.*?(?=^/$)#ism
 
 create : /create/i /or replace/i /force/i /view/i table_name not_delimiter ';'
-	{
-		@table_comments = ();
+   {
+      @table_comments = ();
         my $view_name = $item[5];
         # Hack to strip owner from view name
         $view_name =~ s#.*\.##;
         my $sql = "$item[1] $item[2] $item[3] $item[4] $item[5] $item[6] $item[7]";
-        
+
         $views{ $view_name }{'order'}  = ++$view_order;
         $views{ $view_name }{'name'}   = $view_name;
         $views{ $view_name }{'sql'}    = $sql;
-	}
+   }
 
 not_delimiter: /.*?(?=;)/is
 
@@ -258,18 +237,18 @@ create : ...!create_table ...!create_index /create/i WORD /[^;]+/ ';'
     { @table_comments = () }
 
 create_index : /create/i UNIQUE(?) /index/i
-	{ $return = @{$item[2]} }
+   { $return = @{$item[2]} }
 
 index_name : NAME '.' NAME
     { $item[3] }
-    | NAME 
+    | NAME
     { $item[1] }
 
 global_temporary: /global/i /temporary/i
 
 table_name : NAME '.' NAME
     { $item[3] }
-    | NAME 
+    | NAME
     { $item[1] }
 
 create_definition : table_constraint
@@ -291,7 +270,7 @@ comment : /^\s*(?:#|-{2}).*\n/
         $return     = $comment;
     }
 
-comment : /\/\*/ /[^\*]+/ /\*\// 
+comment : /\/\*/ /[^\*]+/ /\*\//
     {
         my $comment = $item[2];
         $comment    =~ s/^\s*|\s*$//g;
@@ -315,15 +294,15 @@ 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'};
-        push @{ $tables{ $table_name }{'fields'}{ $field_name }{'comments'} }, 
+        push @{ $tables{ $table_name }{'fields'}{ $field_name }{'comments'} },
             $item{'comment_phrase'};
     }
 
 column_name : NAME '.' NAME
     { $return = { table => $item[1], field => $item[3] } }
 
-comment_phrase : /'.*?'/ 
-    { 
+comment_phrase : /'.*?'/
+    {
         my $val = $item[1];
         $val =~ s/^'|'$//g;
         $return = $val;
@@ -351,9 +330,9 @@ field : comment(s?) field_name data_type field_meta(s?) comment(s?)
 
         my @comments = ( @{ $item[1] }, @{ $item[5] } );
 
-        $return = { 
+        $return = {
             type           => 'field',
-            name           => $item{'field_name'}, 
+            name           => $item{'field_name'},
             data_type      => $item{'data_type'}{'type'},
             size           => $item{'data_type'}{'size'},
             null           => $null,
@@ -361,25 +340,25 @@ field : comment(s?) field_name data_type field_meta(s?) comment(s?)
             is_primary_key => $is_pk,
             constraints    => [ @constraints ],
             comments       => [ @comments ],
-        } 
+        }
     }
     | <error>
 
 field_name : NAME
 
 data_type : ora_data_type data_size(?)
-    { 
-        $return  = { 
+    {
+        $return  = {
             type => $item[1],
             size => $item[2][0] || '',
-        } 
+        }
     }
-    
+
 data_size : '(' VALUE(s /,/) data_size_modifier(?) ')'
-    { $item[2] } 
+    { $item[2] }
 
 data_size_modifier: /byte/i
-	| /char/i
+   | /char/i
 
 column_constraint : constraint_name(?) column_constraint_type constraint_state(s?)
     {
@@ -399,7 +378,7 @@ column_constraint : constraint_name(?) column_constraint_type constraint_state(s
             reference_fields => $desc->{'reference_fields'},
 #            match_type       => $desc->{'match_type'},
 #            on_update        => $desc->{'on_update'},
-        } 
+        }
     }
 
 constraint_name : /constraint/i NAME { $item[2] }
@@ -407,16 +386,16 @@ constraint_name : /constraint/i NAME { $item[2] }
 column_constraint_type : /not\s+null/i { $return = { type => 'not_null' } }
     | /unique/i
         { $return = { type => 'unique' } }
-    | /primary\s+key/i 
+    | /primary\s+key/i
         { $return = { type => 'primary_key' } }
     | /check/i check_expression
-        { 
-            $return = { 
-                type       => 'check', 
-                expression => $item[2], 
+        {
+            $return = {
+                type       => 'check',
+                expression => $item[2],
             };
         }
-    | /references/i table_name parens_word_list(?) on_delete(?) 
+    | /references/i table_name parens_word_list(?) on_delete(?)
     {
         $return              =  {
             type             => 'foreign_key',
@@ -432,26 +411,26 @@ LPAREN : '('
 RPAREN : ')'
 
 check_condition_text : /.+\s+in\s+\([^)]+\)/i
-    | /[^)]+/ 
+    | /[^)]+/
 
-check_expression : LPAREN check_condition_text RPAREN 
-    { $return = join( ' ', map { $_ || () } 
-        $item[1], $item[2], $item[3], $item[4][0] ) 
+check_expression : LPAREN check_condition_text RPAREN
+    { $return = join( ' ', map { $_ || () }
+        $item[1], $item[2], $item[3], $item[4][0] )
     }
 
 constraint_state : deferrable { $return = { type => $item[1] } }
     | deferred { $return = { type => $item[1] } }
     | /(no)?rely/i { $return = { type => $item[1] } }
-#    | /using/i /index/i using_index_clause 
+#    | /using/i /index/i using_index_clause
 #        { $return = { type => 'using_index', index => $item[3] } }
     | /(dis|en)able/i { $return = { type => $item[1] } }
     | /(no)?validate/i { $return = { type => $item[1] } }
-    | /exceptions/i /into/i table_name 
+    | /exceptions/i /into/i table_name
         { $return = { type => 'exceptions_into', table => $item[3] } }
 
-deferrable : /not/i /deferrable/i 
+deferrable : /not/i /deferrable/i
     { $return = 'not_deferrable' }
-    | /deferrable/i 
+    | /deferrable/i
     { $return = 'deferrable' }
 
 deferred : /initially/i /(deferred|immediate)/i { $item[2] }
@@ -461,8 +440,8 @@ ora_data_type :
     |
     /n?char/i { $return = 'character' }
     |
-	/n?dec/i { $return = 'decimal' }
-	|
+   /n?dec/i { $return = 'decimal' }
+   |
     /number/i { $return = 'number' }
     |
     /integer/i { $return = 'integer' }
@@ -486,10 +465,10 @@ parens_word_list : '(' WORD(s /,/) ')'
 field_meta : default_val
     | column_constraint
 
-default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/ 
-    { 
+default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/
+    {
         my $val =  $item[2];
-        $val    =~ s/'//g if defined $val; 
+        $val    =~ s/'//g if defined $val;
         $return =  {
             supertype => 'constraint',
             type      => 'default',
@@ -551,19 +530,19 @@ table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrab
             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(s /,/) ')'
-    { 
+    {
         $return = {
             type   => 'primary_key',
             fields => $item[3],
         }
     }
     |
-    /unique/i '(' NAME(s /,/) ')' 
-    { 
+    /unique/i '(' NAME(s /,/) ')'
+    {
         $return    =  {
             type   => 'unique',
             fields => $item[3],
@@ -609,20 +588,20 @@ VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
     | /NULL/
     { 'NULL' }
 
-`;
+END_OF_GRAMMAR
 
-# -------------------------------------------------------------------
 sub parse {
     my ( $translator, $data ) = @_;
-    my $parser = Parse::RecDescent->new($GRAMMAR);
 
-    local $::RD_TRACE = $translator->trace ? 1 : undef;
-    local $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('Oracle');
 
     my $result = $parser->startrule( $data );
     die "Parse failed.\n" unless defined $result;
@@ -633,24 +612,24 @@ sub parse {
     my $schema      = $translator->schema;
     my $indices     = $result->{'indices'};
     my $constraints = $result->{'constraints'};
-    my @tables      = sort { 
-        $result->{'tables'}{ $a }{'order'} 
-        <=> 
+    my @tables      = sort {
+        $result->{'tables'}{ $a }{'order'}
+        <=>
         $result->{'tables'}{ $b }{'order'}
     } keys %{ $result->{'tables'} };
 
     for my $table_name ( @tables ) {
         my $tdata    =  $result->{'tables'}{ $table_name };
         next unless $tdata->{'table_name'};
-        my $table    =  $schema->add_table( 
+        my $table    =  $schema->add_table(
             name     => $tdata->{'table_name'},
             comments => $tdata->{'comments'},
         ) or die $schema->error;
 
         $table->options( $tdata->{'table_options'} );
 
-        my @fields = sort { 
-            $tdata->{'fields'}->{$a}->{'order'} 
+        my @fields = sort {
+            $tdata->{'fields'}->{$a}->{'order'}
             <=>
             $tdata->{'fields'}->{$b}->{'order'}
         } keys %{ $tdata->{'fields'} };
@@ -669,7 +648,7 @@ sub parse {
         }
 
         push @{ $tdata->{'indices'} }, @{ $indices->{ $table_name } || [] };
-        push @{ $tdata->{'constraints'} }, 
+        push @{ $tdata->{'constraints'} },
              @{ $constraints->{ $table_name } || [] };
 
         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
@@ -689,33 +668,33 @@ sub parse {
                 reference_table  => $cdata->{'reference_table'},
                 reference_fields => $cdata->{'reference_fields'},
                 match_type       => $cdata->{'match_type'} || '',
-                on_delete        => $cdata->{'on_delete'} 
+                on_delete        => $cdata->{'on_delete'}
                                  || $cdata->{'on_delete_do'},
-                on_update        => $cdata->{'on_update'} 
+                on_update        => $cdata->{'on_update'}
                                  || $cdata->{'on_update_do'},
             ) or die $table->error;
         }
     }
-    
-    my @procedures = sort { 
+
+    my @procedures = sort {
         $result->{procedures}->{ $a }->{'order'} <=> $result->{procedures}->{ $b }->{'order'}
     } keys %{ $result->{procedures} };
     foreach my $proc_name (@procedures) {
-    	$schema->add_procedure(
-    		name  => $proc_name,
-    		owner => $result->{procedures}->{$proc_name}->{owner},
-    		sql   => $result->{procedures}->{$proc_name}->{sql},
-		);
+      $schema->add_procedure(
+         name  => $proc_name,
+         owner => $result->{procedures}->{$proc_name}->{owner},
+         sql   => $result->{procedures}->{$proc_name}->{sql},
+      );
     }
 
-    my @views = sort { 
+    my @views = sort {
         $result->{views}->{ $a }->{'order'} <=> $result->{views}->{ $b }->{'order'}
     } keys %{ $result->{views} };
     foreach my $view_name (keys %{ $result->{views} }) {
-    	$schema->add_view(
-    		name => $view_name,
-    		sql  => $result->{views}->{$view_name}->{sql},
-		);
+      $schema->add_view(
+         name => $view_name,
+         sql  => $result->{views}->{$view_name}->{sql},
+      );
     }
 
     return 1;