lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.20 2003-06-03 22:38:18 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
   7 #                    darren chamberlain <darren@cpan.org>,
   8 #                    Chris Mungall <cjm@fruitfly.org>
   9 #
  10 # This program is free software; you can redistribute it and/or
  11 # modify it under the terms of the GNU General Public License as
  12 # published by the Free Software Foundation; version 2.
  13 #
  14 # This program is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program; if not, write to the Free Software
  21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  22 # 02111-1307  USA
  23 # -------------------------------------------------------------------
  24
  25 =head1 NAME
  26
  27 SQL::Translator::Parser::MySQL - parser for MySQL
  28
  29 =head1 SYNOPSIS
  30
  31   use SQL::Translator;
  32   use SQL::Translator::Parser::MySQL;
  33
  34   my $translator = SQL::Translator->new;
  35   $translator->parser("SQL::Translator::Parser::MySQL");
  36
  37 =head1 DESCRIPTION
  38
  39 The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
  40
  41 Here's the word from the MySQL site
  42 (http://www.mysql.com/doc/en/CREATE_TABLE.html):
  43
  44   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
  45   [table_options] [select_statement]
  46
  47   or
  48
  49   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
  50
  51   create_definition:
  52     col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
  53               [PRIMARY KEY] [reference_definition]
  54     or    PRIMARY KEY (index_col_name,...)
  55     or    KEY [index_name] (index_col_name,...)
  56     or    INDEX [index_name] (index_col_name,...)
  57     or    UNIQUE [INDEX] [index_name] (index_col_name,...)
  58     or    FULLTEXT [INDEX] [index_name] (index_col_name,...)
  59     or    [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
  60               [reference_definition]
  61     or    CHECK (expr)
  62
  63   type:
  64           TINYINT[(length)] [UNSIGNED] [ZEROFILL]
  65     or    SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
  66     or    MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
  67     or    INT[(length)] [UNSIGNED] [ZEROFILL]
  68     or    INTEGER[(length)] [UNSIGNED] [ZEROFILL]
  69     or    BIGINT[(length)] [UNSIGNED] [ZEROFILL]
  70     or    REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
  71     or    DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
  72     or    FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
  73     or    DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
  74     or    NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
  75     or    CHAR(length) [BINARY]
  76     or    VARCHAR(length) [BINARY]
  77     or    DATE
  78     or    TIME
  79     or    TIMESTAMP
  80     or    DATETIME
  81     or    TINYBLOB
  82     or    BLOB
  83     or    MEDIUMBLOB
  84     or    LONGBLOB
  85     or    TINYTEXT
  86     or    TEXT
  87     or    MEDIUMTEXT
  88     or    LONGTEXT
  89     or    ENUM(value1,value2,value3,...)
  90     or    SET(value1,value2,value3,...)
  91
  92   index_col_name:
  93           col_name [(length)]
  94
  95   reference_definition:
  96           REFERENCES tbl_name [(index_col_name,...)]
  97                      [MATCH FULL | MATCH PARTIAL]
  98                      [ON DELETE reference_option]
  99                      [ON UPDATE reference_option]
 100
 101   reference_option:
 102           RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
 103
 104   table_options:
 105           TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
 106   or      AUTO_INCREMENT = #
 107   or      AVG_ROW_LENGTH = #
 108   or      CHECKSUM = {0 | 1}
 109   or      COMMENT = "string"
 110   or      MAX_ROWS = #
 111   or      MIN_ROWS = #
 112   or      PACK_KEYS = {0 | 1 | DEFAULT}
 113   or      PASSWORD = "string"
 114   or      DELAY_KEY_WRITE = {0 | 1}
 115   or      ROW_FORMAT= { default | dynamic | fixed | compressed }
 116   or      RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=#  RAID_CHUNKSIZE=#
 117   or      UNION = (table_name,[table_name...])
 118   or      INSERT_METHOD= {NO | FIRST | LAST }
 119   or      DATA DIRECTORY="absolute path to directory"
 120   or      INDEX DIRECTORY="absolute path to directory"
 121
 122 =cut
 123
 124 use strict;
 125 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
 126 $VERSION = sprintf "%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/;
 127 $DEBUG   = 0 unless defined $DEBUG;
 128
 129 use Data::Dumper;
 130 use Parse::RecDescent;
 131 use Exporter;
 132 use base qw(Exporter);
 133
 134 @EXPORT_OK = qw(parse);
 135
 136 # Enable warnings within the Parse::RecDescent module.
 137 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
 138 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
 139 $::RD_HINT   = 1; # Give out hints to help fix problems.
 140
 141 $GRAMMAR = q!
 142
 143 {
 144     our ( %tables, $table_order );
 145 }
 146
 147 #
 148 # The "eofile" rule makes the parser fail if any "statement" rule
 149 # fails.  Otherwise, the first successful match by a "statement"
 150 # won't cause the failure needed to know that the parse, as a whole,
 151 # failed. -ky
 152 #
 153 startrule : statement(s) eofile { \%tables }
 154
 155 eofile : /^\Z/
 156
 157 statement : comment
 158     | drop
 159     | create
 160     | <error>
 161
 162 drop : /drop/i WORD(s) ';'
 163
 164 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
 165     {
 166         my $table_name                       = $item{'table_name'};
 167         $tables{ $table_name }{'order'}      = ++$table_order;
 168         $tables{ $table_name }{'table_name'} = $table_name;
 169
 170         my $i = 1;
 171         for my $definition ( @{ $item[7] } ) {
 172             if ( $definition->{'type'} eq 'field' ) {
 173                 my $field_name = $definition->{'name'};
 174                 $tables{ $table_name }{'fields'}{ $field_name } =
 175                     { %$definition, order => $i };
 176                 $i++;
 177
 178                 if ( $definition->{'is_primary_key'} ) {
 179                     push @{ $tables{ $table_name }{'indices'} },
 180                         {
 181                             type   => 'primary_key',
 182                             fields => [ $field_name ],
 183                         }
 184                     ;
 185                 }
 186             }
 187             elsif ( $definition->{'type'} eq 'foreign_key' ) {
 188                 for my $field ( @{ $definition->{'fields'} } ) {
 189                     push @{
 190                         $tables{$table_name}{'fields'}{$field}{'constraints'}
 191                     },
 192                     $definition;
 193                 }
 194             }
 195             else {
 196                 push @{ $tables{ $table_name }{'indices'} },
 197                     $definition;
 198             }
 199         }
 200
 201         for my $opt ( @{ $item{'table_option(s?)'} } ) {
 202             if ( my ( $key, $val ) = each %$opt ) {
 203                 $tables{ $table_name }{'table_options'}{ $key } = $val;
 204             }
 205         }
 206
 207         1;
 208     }
 209
 210 opt_if_not_exists : /if not exists/i
 211
 212 create : /CREATE/i unique(?) /(INDEX|KEY)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
 213     {
 214         push @{ $tables{ $item{'table_name'} }{'indices'} },
 215             {
 216                 name   => $item[4],
 217                 type   => $item[2] ? 'unique' : 'normal',
 218                 fields => $item[8],
 219             }
 220         ;
 221     }
 222
 223 create_definition : index
 224     | foreign_key
 225     | field
 226     | <error>
 227
 228 comment : /^\s*(?:#|-{2}).*\n/
 229
 230 blank : /\s*/
 231
 232 field : field_name data_type field_qualifier(s?) reference_definition(?)
 233     {
 234         my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 235         my $null = defined $item{'not_null'} ? $item{'not_null'} : 1;
 236         delete $qualifiers{'not_null'};
 237         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 238             $qualifiers{ $_ } = 1 for @type_quals;
 239         }
 240
 241         $return = {
 242             type           => 'field',
 243             name           => $item{'field_name'},
 244             data_type      => $item{'data_type'}{'type'},
 245             size           => $item{'data_type'}{'size'},
 246             list           => $item{'data_type'}{'list'},
 247             null           => $null,
 248             constraints    => $item{'reference_definition(?)'},
 249             %qualifiers,
 250         }
 251     }
 252     | <error>
 253
 254 field_qualifier : not_null
 255     {
 256         $return = {
 257              null => $item{'not_null'},
 258         }
 259     }
 260
 261 field_qualifier : default_val
 262     {
 263         $return = {
 264              default => $item{'default_val'},
 265         }
 266     }
 267
 268 field_qualifier : auto_inc
 269     {
 270         $return = {
 271              is_auto_inc => $item{'auto_inc'},
 272         }
 273     }
 274
 275 field_qualifier : primary_key
 276     {
 277         $return = {
 278              is_primary_key => $item{'primary_key'},
 279         }
 280     }
 281
 282 field_qualifier : unsigned
 283     {
 284         $return = {
 285              is_unsigned => $item{'unsigned'},
 286         }
 287     }
 288
 289 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 290     {
 291         $return = {
 292             type             => 'foreign_key',
 293             reference_table  => $item[2],
 294             reference_fields => $item[3][0],
 295             match_type       => $item[4][0],
 296             on_delete_do     => $item[5][0],
 297             on_update_do     => $item[6][0],
 298         }
 299     }
 300
 301
 302 match_type : /match full/i { 'match_full' }
 303     |
 304     /match partial/i { 'match_partial' }
 305
 306 on_delete_do : /on delete/i reference_option
 307     { $item[2] }
 308
 309 on_update_do : /on update/i reference_option
 310     { $item[2] }
 311
 312 reference_option: /restrict/i |
 313     /cascade/i   |
 314     /set null/i  |
 315     /no action/i |
 316     /set default/i
 317     { $item[1] }
 318
 319 index : primary_key_index
 320     | unique_index
 321     | fulltext_index
 322     | normal_index
 323     | <error>
 324
 325 table_name   : WORD
 326
 327 field_name   : WORD
 328
 329 index_name   : WORD
 330
 331 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 332     {
 333         my $type = $item[1];
 334         my $size; # field size, applicable only to non-set fields
 335         my $list; # set list, applicable only to sets (duh)
 336
 337         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 338             $size = undef;
 339             $list = $item[2][0];
 340         }
 341         else {
 342             $size = $item[2][0];
 343             $list = [];
 344         }
 345
 346         unless ( @{ $size || [] } ) {
 347             if ( lc $type eq 'tinyint' ) {
 348                 $size = [4];
 349             }
 350             elsif ( lc $type eq 'smallint' ) {
 351                 $size = [6];
 352             }
 353             elsif ( lc $type eq 'mediumint' ) {
 354                 $size = [9];
 355             }
 356             elsif ( lc $type eq 'int' ) {
 357                 $size = [11];
 358             }
 359             elsif ( lc $type eq 'bigint' ) {
 360                 $size = [20];
 361             }
 362             elsif ( lc $type eq 'float' ) {
 363                 $size = [8,2];
 364             }
 365             elsif ( lc $type eq 'double' ) {
 366                 $size = [8,2];
 367             }
 368             elsif ( lc $type eq 'decimal' ) {
 369                 $size = [8,2];
 370             }
 371         }
 372
 373         $return        = {
 374             type       => $type,
 375             size       => $size,
 376             list       => $list,
 377             qualifiers => $item[3],
 378         }
 379     }
 380
 381 parens_field_list : '(' field_name(s /,/) ')'
 382     { $item[2] }
 383
 384 parens_value_list : '(' VALUE(s /,/) ')'
 385     { $item[2] }
 386
 387 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 388     { lc $item[1] }
 389
 390 field_type   : WORD
 391
 392 create_index : /create/i /index/i
 393
 394 not_null     : /not/i /null/i { $return = 0 }
 395
 396 unsigned     : /unsigned/i { $return = 0 }
 397
 398 default_val  : /default/i /(?:')?[\w\d:.-]*(?:')?/
 399     {
 400         $item[2] =~ s/'//g;
 401         $return  =  $item[2];
 402     }
 403
 404 auto_inc : /auto_increment/i { 1 }
 405
 406 primary_key : /primary/i /key/i { 1 }
 407
 408 foreign_key : opt_constraint(?) /foreign key/i WORD(?) parens_field_list reference_definition
 409     {
 410         $return              =  {
 411             type             => 'foreign_key',
 412             name             => $item[3][0],
 413             fields           => $item[4],
 414             %{ $item{'reference_definition'} },
 415         }
 416     }
 417
 418 opt_constraint : /constraint/i WORD
 419
 420 primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
 421     {
 422         $return    = {
 423             name   => $item{'index_name(?)'}[0],
 424             type   => 'primary_key',
 425             fields => $item[4],
 426         };
 427     }
 428
 429 normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 430     {
 431         $return    = {
 432             name   => $item{'index_name(?)'}[0],
 433             type   => 'normal',
 434             fields => $item[4],
 435         }
 436     }
 437
 438 unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 439     {
 440         $return    = {
 441             name   => $item{'index_name(?)'}[0],
 442             type   => 'unique',
 443             fields => $item[5],
 444         }
 445     }
 446
 447 fulltext_index : fulltext key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 448     {
 449         $return    = {
 450             name   => $item{'index_name(?)'}[0],
 451             type   => 'fulltext',
 452             fields => $item[5],
 453         }
 454     }
 455
 456 name_with_opt_paren : NAME parens_value_list(s?)
 457     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 458
 459 fulltext : /fulltext/i { 1 }
 460
 461 unique : /unique/i { 1 }
 462
 463 key : /key/i | /index/i
 464
 465 table_option : /[^\s;]*/
 466     {
 467         $return = { split /=/, $item[1] }
 468     }
 469
 470 CREATE : /create/i
 471
 472 TEMPORARY : /temporary/i
 473
 474 TABLE : /table/i
 475
 476 WORD : /\w+/
 477
 478 DIGITS : /\d+/
 479
 480 COMMA : ','
 481
 482 NAME    : "`" /\w+/ "`"
 483     { $item[2] }
 484     | /\w+/
 485     { $item[1] }
 486
 487 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 488     { $item[1] }
 489     | /'.*?'/   # XXX doesn't handle embedded quotes
 490     { $item[1] }
 491     | /NULL/
 492     { 'NULL' }
 493
 494 !;
 495
 496 # -------------------------------------------------------------------
 497 sub parse {
 498     my ( $translator, $data ) = @_;
 499     my $parser = Parse::RecDescent->new($GRAMMAR);
 500
 501     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 502     local $DEBUG       = $translator->debug;
 503
 504     unless (defined $parser) {
 505         return $translator->error("Error instantiating Parse::RecDescent ".
 506             "instance: Bad grammer");
 507     }
 508
 509     my $result = $parser->startrule($data);
 510     return $translator->error( "Parse failed." ) unless defined $result;
 511     warn Dumper( $result ) if $DEBUG;
 512
 513     my $schema = $translator->schema;
 514     for my $table_name ( keys %{ $result } ) {
 515         my $tdata =  $result->{ $table_name };
 516         my $table =  $schema->add_table(
 517             name  => $tdata->{'table_name'},
 518         ) or die $schema->error;
 519
 520         my @fields = sort {
 521             $tdata->{'fields'}->{$a}->{'order'}
 522             <=>
 523             $tdata->{'fields'}->{$b}->{'order'}
 524         } keys %{ $tdata->{'fields'} };
 525
 526         for my $fname ( @fields ) {
 527             my $fdata = $tdata->{'fields'}{ $fname };
 528             my $field = $table->add_field(
 529                 name              => $fdata->{'name'},
 530                 data_type         => $fdata->{'data_type'},
 531                 size              => $fdata->{'size'},
 532                 default_value     => $fdata->{'default'},
 533                 is_auto_increment => $fdata->{'is_auto_inc'},
 534                 is_nullable       => $fdata->{'null'},
 535             ) or die $table->error;
 536         }
 537     }
 538
 539     return $result;
 540 }
 541
 542 1;
 543
 544 # ----------------------------------------------------
 545 # Where man is not nature is barren.
 546 # William Blake
 547 # ----------------------------------------------------
 548
 549 =pod
 550
 551 =head1 AUTHOR
 552
 553 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 554 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 555
 556 =head1 SEE ALSO
 557
 558 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 559
 560 =cut