Just the fairy.

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / Oracle.pm

diff --git a/lib/SQL/Translator/Parser/Oracle.pm b/lib/SQL/Translator/Parser/Oracle.pm
index 5159277..410c70f 100644 (file)
--- a/lib/SQL/Translator/Parser/Oracle.pm
+++ b/lib/SQL/Translator/Parser/Oracle.pm
@@ -1,9 +1,9 @@
 package SQL::Translator::Parser::Oracle;
 
 # -------------------------------------------------------------------
-# $Id: Oracle.pm,v 1.11 2003-09-09 15:57:38 kycl4rk Exp $
+# $Id: Oracle.pm,v 1.17 2004-02-11 21:36:00 kycl4rk Exp $
 # -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
+# 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
@@ -91,11 +91,14 @@ constrnt_state
           [ENABLE|DISABLE] [VALIDATE|NOVALIDATE]
               [EXCEPTIONS INTO [schema.]table]
 
+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 = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
@@ -114,7 +117,7 @@ my $parser;
 
 $GRAMMAR = q!
 
-{ my ( %tables, $table_order, @table_comments ) }
+{ my ( %tables, %indices, $table_order, @table_comments ) }
 
 #
 # The "eofile" rule makes the parser fail if any "statement" rule
@@ -122,11 +125,19 @@ $GRAMMAR = q!
 # 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 
+    { 
+        $return = {
+            tables  => \%tables,
+            indices => \%indices,
+        };
+    }
 
 eofile : /^\Z/
 
-statement : create
+statement : remark
+    | prompt
+    | create
     | table_comment
     | comment_on_table
     | comment_on_column
@@ -178,17 +189,16 @@ create : create_table table_name '(' create_definition(s /,/) ')' table_option(s
         }
 
         for my $option ( @{ $item[6] } ) {
-            $tables{ $table_name }{'table_options'}{ $option->{'type'} } = 
-                $option;
+            push @{ $tables{ $table_name }{'table_options'} }, $option;
         }
 
         1;
     }
 
-create : /create/i /index/i WORD /on/i table_name parens_word_list ';'
+create : /create/i /index/i WORD /on/i table_name parens_word_list table_option(?) ';'
     {
         my $table_name = $item[5];
-        push @{ $tables{ $table_name }{'indices'} }, {
+        push @{ $indices{ $table_name } }, {
             name   => $item[3],
             type   => 'normal',
             fields => $item[6][0],
@@ -232,6 +242,12 @@ comment : /\/\*/ /[^\*]+/ /\*\//
         $return = $comment;
     }
 
+remark : /^REM\s+.*\n/
+
+prompt : /prompt/i /(table|index|sequence|trigger)/i ';'
+
+prompt : /prompt\s+create\s+.*\n/i
+
 comment_on_table : /comment/i /on/i /table/i table_name /is/i comment_phrase ';'
     {
         push @{ $tables{ $item{'table_name'} }{'comments'} }, $item{'comment_phrase'};
@@ -302,7 +318,6 @@ data_type : ora_data_type parens_value_list(?)
     }
 
 column_constraint : constraint_name(?) column_constraint_type 
-#constraint_state(s /,/)
     {
         my $desc       = $item{'column_constraint_type'};
         my $type       = $desc->{'type'};
@@ -371,6 +386,8 @@ ora_data_type :
        |
     /number/i { $return = 'number' }
     |
+    /integer/i { $return = 'integer' }
+    |
     /(pls_integer|binary_integer)/i { $return = 'integer' }
     |
     /interval\s+day/i { $return = 'interval_day' }
@@ -403,6 +420,26 @@ default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/
 
 create_table : /create/i global_temporary(?) /table/i
 
+table_option : /organization/i WORD
+    {
+        $return = { 'ORGANIZATION' => $item[2] }
+    }
+
+table_option : /nomonitoring/i
+    {
+        $return = { 'NOMONITORING' => undef }
+    }
+
+table_option : /parallel/i '(' key_value(s) ')'
+    {
+        $return = { 'PARALLEL' => $item[3] }
+    }
+
+key_value : WORD VALUE
+    {
+        $return = { $item[1], $item[2] }
+    }
+
 table_option : /[^;]+/
 
 table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
@@ -498,22 +535,28 @@ sub parse {
             "instance: Bad grammer");
     }
 
-    my $result = $parser->startrule($data);
+    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'} <=> $result->{ $b }->{'order'}
-    } keys %{ $result };
+    my $schema  = $translator->schema;
+    my $indices = $result->{'indices'};
+    my @tables  = sort { 
+        $result->{'tables'}{ $a }{'order'} 
+        <=> 
+        $result->{'tables'}{ $b }{'order'}
+    } keys %{ $result->{'tables'} };
 
     for my $table_name ( @tables ) {
-        my $tdata    =  $result->{ $table_name };
+        my $tdata    =  $result->{'tables'}{ $table_name };
+        next unless $tdata->{'table_name'};
         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'} 
             <=>
@@ -539,6 +582,8 @@ sub parse {
             }
         }
 
+        push @{ $tdata->{'indices'} }, @{ $indices->{ $table_name } || [] };
+
         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
             my $index  =  $table->add_index(
                 name   => $idata->{'name'},
@@ -579,6 +624,6 @@ Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 
 =head1 SEE ALSO
 
-perl(1), Parse::RecDescent.
+SQL::Translator, Parse::RecDescent, DDL::Oracle.
 
 =cut