Changed references to on_delete_do to on_delete and on_update_do to on_update. I...
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / MySQL.pm
index a877a9b..5d4a4d1 100644 (file)
@@ -1,11 +1,9 @@
 package SQL::Translator::Parser::MySQL;
 
 # -------------------------------------------------------------------
-# $Id: MySQL.pm,v 1.42 2004-01-25 18:09:51 kycl4rk Exp $
+# $Id: MySQL.pm,v 1.50 2005-06-28 16:39:41 mwz444 Exp $
 # -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
-#                    darren chamberlain <darren@cpan.org>,
-#                    Chris Mungall <cjm@fruitfly.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
@@ -119,11 +117,24 @@ Here's the word from the MySQL site
   or      DATA DIRECTORY="absolute path to directory"
   or      INDEX DIRECTORY="absolute path to directory"
 
+A subset of the ALTER TABLE syntax that allows addition of foreign keys:
+
+  ALTER [IGNORE] TABLE tbl_name alter_specification [, alter_specification] ...
+
+  alter_specification:
+          ADD [CONSTRAINT [symbol]]
+          FOREIGN KEY [index_name] (index_col_name,...)
+             [reference_definition]
+
+A subset of INSERT that we ignore:
+
+  INSERT anything
+
 =cut
 
 use strict;
 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.42 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.50 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Data::Dumper;
@@ -141,7 +152,7 @@ $::RD_HINT   = 1; # Give out hints to help fix problems.
 $GRAMMAR = q!
 
 { 
-    my ( %tables, $table_order, @table_comments );
+    my ( $database_name, %tables, $table_order, @table_comments );
 }
 
 #
@@ -150,7 +161,9 @@ $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 { 
+    { tables => \%tables, database_name => $database_name } 
+}
 
 eofile : /^\Z/
 
@@ -159,10 +172,15 @@ statement : comment
     | set
     | drop
     | create
+    | alter
+    | insert
     | <error>
 
 use : /use/i WORD ';'
-    { @table_comments = () }
+    {
+        $database_name = $item[2];
+        @table_comments = ();
+    }
 
 set : /set/i /[^;]+/ ';'
     { @table_comments = () }
@@ -172,10 +190,26 @@ drop : /drop/i TABLE /[^;]+/ ';'
 drop : /drop/i WORD(s) ';'
     { @table_comments = () }
 
+insert : /insert/i  /[^;]+/ ';'
+
+alter : ALTER TABLE table_name alter_specification(s /,/) ';'
+    {
+        my $table_name                       = $item{'table_name'};
+    die "Cannot ALTER table '$table_name'; it does not exist"
+        unless $tables{ $table_name };
+        for my $definition ( @{ $item[4] } ) { 
+        $definition->{'extra'}->{'alter'} = 1;
+        push @{ $tables{ $table_name }{'constraints'} }, $definition;
+    }
+    }
+
+alter_specification : ADD foreign_key_def
+    { $return = $item[2] }
+
 create : CREATE /database/i WORD ';'
     { @table_comments = () }
 
-create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
+create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) ';'
     { 
         my $table_name                       = $item{'table_name'};
         $tables{ $table_name }{'order'}      = ++$table_order;
@@ -212,7 +246,15 @@ create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_de
         }
 
         if ( my @options = @{ $item{'table_option(s?)'} } ) {
-            $tables{ $table_name }{'table_options'} = \@options;
+            for my $option ( @options ) {
+                my ( $key, $value ) = each %$option;
+                if ( $key eq 'comment' ) {
+                    push @{ $tables{ $table_name }{'comments'} }, $value;
+                }
+                else {
+                    push @{ $tables{ $table_name }{'table_options'} }, $option;
+                }
+            }
         }
 
         1;
@@ -241,23 +283,39 @@ create_definition : constraint
 comment : /^\s*(?:#|-{2}).*\n/ 
     { 
         my $comment =  $item[1];
-        $comment    =~ s/^\s*(#|-{2})\s*//;
+        $comment    =~ s/^\s*(#|--)\s*//;
         $comment    =~ s/\s*$//;
         $return     = $comment;
         push @table_comments, $comment;
     }
 
+comment : /\/\*/ /[^\*]+/ /\*\// ';'
+    {
+        my $comment = $item[2];
+        $comment    =~ s/^\s*|\s*$//g;
+        $return = $comment;
+    }
+
 field_comment : /^\s*(?:#|-{2}).*\n/ 
     { 
         my $comment =  $item[1];
-        $comment    =~ s/^\s*(#|-{2})\s*//;
+        $comment    =~ s/^\s*(#|--)\s*//;
         $comment    =~ s/\s*$//;
         $return     = $comment;
     }
 
+
+field_comment2 : /comment/i /'.*?'/
+    {
+        my $comment = $item[2];
+        $comment    =~ s/^'//;
+        $comment    =~ s/'$//;
+        $return     = $comment;
+    }
+
 blank : /\s*/
 
-field : field_comment(s?) field_name data_type field_qualifier(s?) reference_definition(?) field_comment(s?)
+field : field_comment(s?) field_name data_type field_qualifier(s?) field_comment2(?) reference_definition(?) on_update(?) field_comment(s?)
     { 
         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
@@ -268,7 +326,7 @@ field : field_comment(s?) field_name data_type field_qualifier(s?) reference_def
                    ? $qualifiers{'not_null'} : 1;
         delete $qualifiers{'not_null'};
 
-        my @comments = ( @{ $item[1] }, @{ $item[6] } );
+        my @comments = ( @{ $item[1] }, @{ $item[5] }, @{ $item[8] } );
 
         $return = { 
             supertype   => 'field',
@@ -322,19 +380,33 @@ field_qualifier : unsigned
 field_qualifier : /character set/i WORD
     {
         $return = {
-            character_set => $item[2],
+            'CHARACTER SET' => $item[2],
+        }
+    }
+
+field_qualifier : /collate/i WORD
+    {
+        $return = {
+            COLLATE => $item[2],
+        }
+    }
+
+field_qualifier : /on update/i CURRENT_TIMESTAMP
+    {
+        $return = {
+            'ON UPDATE' => $item[2],
         }
     }
 
-reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
+reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
     {
         $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],
+            on_delete        => $item[5][0],
+            on_update        => $item[6][0],
         }
     }
 
@@ -342,10 +414,14 @@ match_type : /match full/i { 'full' }
     |
     /match partial/i { 'partial' }
 
-on_delete_do : /on delete/i reference_option
+on_delete : /on delete/i reference_option
     { $item[2] }
 
-on_update_do : /on update/i reference_option
+on_update : 
+    /on update/i 'CURRENT_TIMESTAMP'
+    { $item[2] }
+    |
+    /on update/i reference_option
     { $item[2] }
 
 reference_option: /restrict/i | 
@@ -390,7 +466,7 @@ data_type    : WORD parens_value_list(s?) type_qualifier(s?)
             elsif ( lc $type eq 'mediumint' ) {
                 $size = 9;
             }
-            elsif ( $type =~ /^int(eger)?$/ ) {
+            elsif ( $type =~ /^int(eger)?$/i ) {
                 $type = 'int';
                 $size = 11;
             }
@@ -438,7 +514,11 @@ field_type   : WORD
 
 create_index : /create/i /index/i
 
-not_null     : /not/i /null/i { $return = 0 }
+not_null     : /not/i /null/i 
+    { $return = 0 }
+    |
+    /null/i
+    { $return = 1 }
 
 unsigned     : /unsigned/i { $return = 0 }
 
@@ -448,7 +528,13 @@ unsigned     : /unsigned/i { $return = 0 }
 #        $return  =  $item[2];
 #    }
 
-default_val : /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
+default_val : 
+    /default/i 'CURRENT_TIMESTAMP'
+    {
+        $return =  $item[2];
+    }
+    |
+    /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
     {
         $item[2] =~ s/^\s*'|'\s*$//g;
         $return  =  $item[2];
@@ -474,10 +560,16 @@ 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 WORD
+    { $return = $item[3] }
+    |
+    /constraint/i NAME /foreign key/i
+    { $return = $item[2] }
+    |
+    /constraint/i /foreign key/i
     { $return = '' }
     |
-    /constraint/i WORD /foreign key/i
+    /foreign key/i WORD
     { $return = $item[2] }
     |
     /foreign key/i
@@ -534,6 +626,23 @@ table_option : WORD /\s*=\s*/ WORD
     { 
         $return = { $item[1] => $item[3] };
     }
+    | /comment/i /=/ /'.*?'/
+    {
+        my $comment = $item[3];
+        $comment    =~ s/^'//;
+        $comment    =~ s/'$//;
+        $return     = { comment => $comment };
+    }
+    | /(default )?(charset|character set)/i /\s*=\s*/ WORD
+    { 
+        $return = { 'CHARACTER SET' => $item[3] };
+    }
+    
+default : /default/i
+
+ADD : /add/i
+
+ALTER : /alter/i
 
 CREATE : /create/i
 
@@ -564,6 +673,10 @@ VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
     | /NULL/
     { 'NULL' }
 
+CURRENT_TIMESTAMP : /current_timestamp(\(\))?/i
+       | /now\(\)/i
+       { 'CURRENT_TIMESTAMP' }
+       
 !;
 
 # -------------------------------------------------------------------
@@ -581,15 +694,19 @@ sub parse {
 
     my $result = $parser->startrule($data);
     return $translator->error( "Parse failed." ) unless defined $result;
-    warn Dumper( $result ) if $DEBUG;
+    warn "Parse result:".Dumper( $result ) if $DEBUG;
 
     my $schema = $translator->schema;
+    $schema->name($result->{'database_name'}) if $result->{'database_name'};
+
     my @tables = sort { 
-        $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
-    } keys %{ $result };
+        $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 };
         my $table =  $schema->add_table( 
             name  => $tdata->{'table_name'},
         ) or die $schema->error;
@@ -616,7 +733,8 @@ sub parse {
 
             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 
-            for my $qual ( qw[ binary unsigned zerofill list ] ) {
+            for my $qual ( qw[ binary unsigned zerofill list collate ],
+                       'character set', 'on update' ) {
                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
                     next if ref $val eq 'ARRAY' && !@$val;
                     $field->extra( $qual, $val );
@@ -659,8 +777,8 @@ sub parse {
                 reference_table  => $cdata->{'reference_table'},
                 reference_fields => $cdata->{'reference_fields'},
                 match_type       => $cdata->{'match_type'} || '',
-                on_delete        => $cdata->{'on_delete_do'},
-                on_update        => $cdata->{'on_update_do'},
+                on_delete        => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
+                on_update        => $cdata->{'on_update'} || $cdata->{'on_update_do'},
             ) or die $table->error;
         }
     }