X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FAccess.pm;h=bd51ec958a0f9639746d442e4c942f9d33c20f32;hb=c0ec0e22d3f0e3852c00daac5ef5763010b410c3;hp=eaceb482c8095c856ac65ed24d941c6a06f3174e;hpb=935800450f88b0500c4fa7c3b174cd22b5f9eb56;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Parser/Access.pm b/lib/SQL/Translator/Parser/Access.pm
index eaceb48..bd51ec9 100644
--- a/lib/SQL/Translator/Parser/Access.pm
+++ b/lib/SQL/Translator/Parser/Access.pm
@@ -14,37 +14,34 @@ SQL::Translator::Parser::Access - parser for Access as produced by mdbtools
 
 =head1 DESCRIPTION
 
-The grammar derived from the MySQL grammar.  The input is expected to be 
+The grammar derived from the MySQL grammar.  The input is expected to be
 something similar to the output of mdbtools (http://mdbtools.sourceforge.net/).
 
 =cut
 
 use strict;
-use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
-$DEBUG   = 0 unless defined $DEBUG;
+use warnings;
 
-use Data::Dumper;
-use Parse::RecDescent;
-use Exporter;
-use base qw(Exporter);
+our $VERSION = '1.59';
+
+our $DEBUG;
+$DEBUG = 0 unless defined $DEBUG;
 
-@EXPORT_OK = qw(parse);
+use Data::Dumper;
+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, $table_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
 #
@@ -74,7 +71,7 @@ create : CREATE /database/i WORD ';'
     { @table_comments = () }
 
 create : CREATE TABLE table_name '(' create_definition(s /,/) ')' ';'
-    { 
+    {
         my $table_name                       = $item{'table_name'};
         $tables{ $table_name }{'order'}      = ++$table_order;
         $tables{ $table_name }{'table_name'} = $table_name;
@@ -88,10 +85,10 @@ create : CREATE TABLE table_name '(' create_definition(s /,/) ')' ';'
         for my $definition ( @{ $item[5] } ) {
             if ( $definition->{'supertype'} eq 'field' ) {
                 my $field_name = $definition->{'name'};
-                $tables{ $table_name }{'fields'}{ $field_name } = 
+                $tables{ $table_name }{'fields'}{ $field_name } =
                     { %$definition, order => $i };
                 $i++;
-        
+
                 if ( $definition->{'is_primary_key'} ) {
                     push @{ $tables{ $table_name }{'constraints'} },
                         {
@@ -124,64 +121,64 @@ create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_n
         ;
     }
 
-create_definition : constraint 
+create_definition : constraint
     | index
     | field
     | comment
     | <error>
 
-comment : /^\s*--(.*)\n/ 
-    { 
+comment : /^\s*--(.*)\n/
+    {
         my $comment =  $1;
         $return     = $comment;
         push @table_comments, $comment;
     }
 
 field : field_name data_type field_qualifier(s?) reference_definition(?)
-    { 
-        $return = { 
+    {
+        $return = {
             supertype   => 'field',
-            name        => $item{'field_name'}, 
+            name        => $item{'field_name'},
             data_type   => $item{'data_type'}{'type'},
             size        => $item{'data_type'}{'size'},
             constraints => $item{'reference_definition(?)'},
-        } 
+        }
     }
     | <error>
 
 field_qualifier : not_null
-    { 
-        $return = { 
+    {
+        $return = {
              null => $item{'not_null'},
-        } 
+        }
     }
 
 field_qualifier : default_val
-    { 
-        $return = { 
+    {
+        $return = {
              default => $item{'default_val'},
-        } 
+        }
     }
 
 field_qualifier : auto_inc
-    { 
-        $return = { 
+    {
+        $return = {
              is_auto_inc => $item{'auto_inc'},
-        } 
+        }
     }
 
 field_qualifier : primary_key
-    { 
-        $return = { 
+    {
+        $return = {
              is_primary_key => $item{'primary_key'},
-        } 
+        }
     }
 
 field_qualifier : unsigned
-    { 
-        $return = { 
+    {
+        $return = {
              is_unsigned => $item{'unsigned'},
-        } 
+        }
     }
 
 field_qualifier : /character set/i WORD
@@ -213,12 +210,12 @@ on_delete : /on delete/i reference_option
 on_update : /on update/i reference_option
     { $item[2] }
 
-reference_option: /restrict/i | 
-    /cascade/i   | 
-    /set null/i  | 
-    /no action/i | 
+reference_option: /restrict/i |
+    /cascade/i   |
+    /set null/i  |
+    /no action/i |
     /set default/i
-    { $item[1] }  
+    { $item[1] }
 
 index : normal_index
     | fulltext_index
@@ -231,12 +228,12 @@ field_name   : NAME
 index_name   : NAME
 
 data_type    : access_data_type parens_value_list(s?) type_qualifier(s?)
-    { 
-        $return        = { 
+    {
+        $return        = {
             type       => $item[1],
             size       => $item[2][0],
             qualifiers => $item[3],
-        } 
+        }
     }
 
 access_data_type : /long integer/i { $return = 'Long Integer' }
@@ -262,7 +259,7 @@ not_null     : /not/i /null/i { $return = 0 }
 
 unsigned     : /unsigned/i { $return = 0 }
 
-default_val : /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
+default_val : /default/i /'(?:.*?\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
     {
         $item[2] =~ s/^\s*'|'\s*$//g;
         $return  =  $item[2];
@@ -288,7 +285,7 @@ foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
         }
     }
 
-foreign_key_def_begin : /constraint/i /foreign key/i 
+foreign_key_def_begin : /constraint/i /foreign key/i
     { $return = '' }
     |
     /constraint/i WORD /foreign key/i
@@ -298,8 +295,8 @@ foreign_key_def_begin : /constraint/i /foreign key/i
     { $return = '' }
 
 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
-    { 
-        $return       = { 
+    {
+        $return       = {
             supertype => 'constraint',
             name      => $item{'index_name(?)'}[0],
             type      => 'primary_key',
@@ -308,33 +305,33 @@ primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
     }
 
 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
-    { 
-        $return       = { 
+    {
+        $return       = {
             supertype => 'constraint',
             name      => $item{'index_name(?)'}[0],
             type      => 'unique',
             fields    => $item[5],
-        } 
+        }
     }
 
 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
-    { 
-        $return       = { 
+    {
+        $return       = {
             supertype => 'index',
             type      => 'normal',
             name      => $item{'index_name(?)'}[0],
             fields    => $item[4],
-        } 
+        }
     }
 
 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
-    { 
-        $return       = { 
+    {
+        $return       = {
             supertype => 'index',
             type      => 'fulltext',
             name      => $item{'index_name(?)'}[0],
             fields    => $item[5],
-        } 
+        }
     }
 
 name_with_opt_paren : NAME parens_value_list(s?)
@@ -345,7 +342,7 @@ UNIQUE : /unique/i { 1 }
 KEY : /key/i | /index/i
 
 table_option : WORD /\s*=\s*/ WORD
-    { 
+    {
         $return = { $item[1] => $item[3] };
     }
 
@@ -368,9 +365,9 @@ NAME    : "`" /\w+/ "`"
 
 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
     { $item[1] }
-    | /'.*?'/   
-    { 
-        # remove leading/trailing quotes 
+    | /'.*?'/
+    {
+        # remove leading/trailing quotes
         my $val = $item[1];
         $val    =~ s/^['"]|['"]$//g;
         $return = $val;
@@ -378,40 +375,40 @@ VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
     | /NULL/
     { 'NULL' }
 
-!;
+END_OF_GRAMMAR
 
-# -------------------------------------------------------------------
 sub parse {
     my ( $translator, $data ) = @_;
-    my $parser = Parse::RecDescent->new($GRAMMAR);
+
+    # 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.
 
     local $::RD_TRACE  = $translator->trace ? 1 : undef;
     local $DEBUG       = $translator->debug;
 
-    unless (defined $parser) {
-        return $translator->error("Error instantiating Parse::RecDescent ".
-            "instance: Bad grammer");
-    }
+    my $parser = ddl_parser_instance('Access');
 
     my $result = $parser->startrule($data);
     return $translator->error( "Parse failed." ) unless defined $result;
     warn Dumper( $result ) if $DEBUG;
 
     my $schema = $translator->schema;
-    my @tables = sort { 
+    my @tables = sort {
         $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
     } keys %{ $result };
 
     for my $table_name ( @tables ) {
         my $tdata =  $result->{ $table_name };
-        my $table =  $schema->add_table( 
+        my $table =  $schema->add_table(
             name  => $tdata->{'table_name'},
         ) or die $schema->error;
 
         $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'} };