lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.41 2004-01-23 03:34:32 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.41 $ =~ /(\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     my ( %tables, $table_order, @table_comments );
 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     | use
 159     | set
 160     | drop
 161     | create
 162     | <error>
 163
 164 use : /use/i WORD ';'
 165     { @table_comments = () }
 166
 167 set : /set/i /[^;]+/ ';'
 168     { @table_comments = () }
 169
 170 drop : /drop/i TABLE /[^;]+/ ';'
 171
 172 drop : /drop/i WORD(s) ';'
 173     { @table_comments = () }
 174
 175 create : CREATE /database/i WORD ';'
 176     { @table_comments = () }
 177
 178 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
 179     {
 180         my $table_name                       = $item{'table_name'};
 181         $tables{ $table_name }{'order'}      = ++$table_order;
 182         $tables{ $table_name }{'table_name'} = $table_name;
 183
 184         if ( @table_comments ) {
 185             $tables{ $table_name }{'comments'} = [ @table_comments ];
 186             @table_comments = ();
 187         }
 188
 189         my $i = 1;
 190         for my $definition ( @{ $item[7] } ) {
 191             if ( $definition->{'supertype'} eq 'field' ) {
 192                 my $field_name = $definition->{'name'};
 193                 $tables{ $table_name }{'fields'}{ $field_name } =
 194                     { %$definition, order => $i };
 195                 $i++;
 196
 197                 if ( $definition->{'is_primary_key'} ) {
 198                     push @{ $tables{ $table_name }{'constraints'} },
 199                         {
 200                             type   => 'primary_key',
 201                             fields => [ $field_name ],
 202                         }
 203                     ;
 204                 }
 205             }
 206             elsif ( $definition->{'supertype'} eq 'constraint' ) {
 207                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 208             }
 209             elsif ( $definition->{'supertype'} eq 'index' ) {
 210                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 211             }
 212         }
 213
 214         if ( my @options = @{ $item{'table_option(s?)'} } ) {
 215             $tables{ $table_name }{'table_options'} = \@options;
 216         }
 217
 218         1;
 219     }
 220
 221 opt_if_not_exists : /if not exists/i
 222
 223 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
 224     {
 225         @table_comments = ();
 226         push @{ $tables{ $item{'table_name'} }{'indices'} },
 227             {
 228                 name   => $item[4],
 229                 type   => $item[2] ? 'unique' : 'normal',
 230                 fields => $item[8],
 231             }
 232         ;
 233     }
 234
 235 create_definition : constraint
 236     | index
 237     | field
 238     | comment
 239     | <error>
 240
 241 comment : /^\s*(?:#|-{2}).*\n/
 242     {
 243         my $comment =  $item[1];
 244         $comment    =~ s/^\s*(#|-{2})\s*//;
 245         $comment    =~ s/\s*$//;
 246         $return     = $comment;
 247         push @table_comments, $comment;
 248     }
 249
 250 field_comment : /^\s*(?:#|-{2}).*\n/
 251     {
 252         my $comment =  $item[1];
 253         $comment    =~ s/^\s*(#|-{2})\s*//;
 254         $comment    =~ s/\s*$//;
 255         $return     = $comment;
 256     }
 257
 258 blank : /\s*/
 259
 260 field : field_comment(s?) field_name data_type field_qualifier(s?) reference_definition(?) field_comment(s?)
 261     {
 262         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 263         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 264             $qualifiers{ $_ } = 1 for @type_quals;
 265         }
 266
 267         my $null = defined $qualifiers{'not_null'}
 268                    ? $qualifiers{'not_null'} : 1;
 269         delete $qualifiers{'not_null'};
 270
 271         my @comments = ( @{ $item[1] }, @{ $item[6] } );
 272
 273         $return = {
 274             supertype   => 'field',
 275             name        => $item{'field_name'},
 276             data_type   => $item{'data_type'}{'type'},
 277             size        => $item{'data_type'}{'size'},
 278             list        => $item{'data_type'}{'list'},
 279             null        => $null,
 280             constraints => $item{'reference_definition(?)'},
 281             comments    => [ @comments ],
 282             %qualifiers,
 283         }
 284     }
 285     | <error>
 286
 287 field_qualifier : not_null
 288     {
 289         $return = {
 290              null => $item{'not_null'},
 291         }
 292     }
 293
 294 field_qualifier : default_val
 295     {
 296         $return = {
 297              default => $item{'default_val'},
 298         }
 299     }
 300
 301 field_qualifier : auto_inc
 302     {
 303         $return = {
 304              is_auto_inc => $item{'auto_inc'},
 305         }
 306     }
 307
 308 field_qualifier : primary_key
 309     {
 310         $return = {
 311              is_primary_key => $item{'primary_key'},
 312         }
 313     }
 314
 315 field_qualifier : unsigned
 316     {
 317         $return = {
 318              is_unsigned => $item{'unsigned'},
 319         }
 320     }
 321
 322 field_qualifier : /character set/i WORD
 323     {
 324         $return = {
 325             character_set => $item[2],
 326         }
 327     }
 328
 329 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 330     {
 331         $return = {
 332             type             => 'foreign_key',
 333             reference_table  => $item[2],
 334             reference_fields => $item[3][0],
 335             match_type       => $item[4][0],
 336             on_delete_do     => $item[5][0],
 337             on_update_do     => $item[6][0],
 338         }
 339     }
 340
 341 match_type : /match full/i { 'full' }
 342     |
 343     /match partial/i { 'partial' }
 344
 345 on_delete_do : /on delete/i reference_option
 346     { $item[2] }
 347
 348 on_update_do : /on update/i reference_option
 349     { $item[2] }
 350
 351 reference_option: /restrict/i |
 352     /cascade/i   |
 353     /set null/i  |
 354     /no action/i |
 355     /set default/i
 356     { $item[1] }
 357
 358 index : normal_index
 359     | fulltext_index
 360     | <error>
 361
 362 table_name   : NAME
 363
 364 field_name   : NAME
 365
 366 index_name   : NAME
 367
 368 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 369     {
 370         my $type = $item[1];
 371         my $size; # field size, applicable only to non-set fields
 372         my $list; # set list, applicable only to sets (duh)
 373
 374         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 375             $size = undef;
 376             $list = $item[2][0];
 377         }
 378         else {
 379             $size = $item[2][0];
 380             $list = [];
 381         }
 382
 383         unless ( @{ $size || [] } ) {
 384             if ( lc $type eq 'tinyint' ) {
 385                 $size = 4;
 386             }
 387             elsif ( lc $type eq 'smallint' ) {
 388                 $size = 6;
 389             }
 390             elsif ( lc $type eq 'mediumint' ) {
 391                 $size = 9;
 392             }
 393             elsif ( $type =~ /^int(eger)?$/ ) {
 394                 $type = 'int';
 395                 $size = 11;
 396             }
 397             elsif ( lc $type eq 'bigint' ) {
 398                 $size = 20;
 399             }
 400             elsif (
 401                 lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/
 402             ) {
 403                 $size = [8,2];
 404             }
 405         }
 406
 407         if ( $type =~ /^tiny(text|blob)$/i ) {
 408             $size = 255;
 409         }
 410         elsif ( $type =~ /^(blob|text)$/i ) {
 411             $size = 65_535;
 412         }
 413         elsif ( $type =~ /^medium(blob|text)$/i ) {
 414             $size = 16_777_215;
 415         }
 416         elsif ( $type =~ /^long(blob|text)$/i ) {
 417             $size = 4_294_967_295;
 418         }
 419
 420         $return        = {
 421             type       => $type,
 422             size       => $size,
 423             list       => $list,
 424             qualifiers => $item[3],
 425         }
 426     }
 427
 428 parens_field_list : '(' field_name(s /,/) ')'
 429     { $item[2] }
 430
 431 parens_value_list : '(' VALUE(s /,/) ')'
 432     { $item[2] }
 433
 434 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 435     { lc $item[1] }
 436
 437 field_type   : WORD
 438
 439 create_index : /create/i /index/i
 440
 441 not_null     : /not/i /null/i { $return = 0 }
 442
 443 unsigned     : /unsigned/i { $return = 0 }
 444
 445 default_val  : /default/i /(?:')?[\s\w\d:.-]*(?:')?/
 446     {
 447         $item[2] =~ s/'//g;
 448         $return  =  $item[2];
 449     }
 450
 451 auto_inc : /auto_increment/i { 1 }
 452
 453 primary_key : /primary/i /key/i { 1 }
 454
 455 constraint : primary_key_def
 456     | unique_key_def
 457     | foreign_key_def
 458     | <error>
 459
 460 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 461     {
 462         $return              =  {
 463             supertype        => 'constraint',
 464             type             => 'foreign_key',
 465             name             => $item[1],
 466             fields           => $item[3],
 467             %{ $item{'reference_definition'} },
 468         }
 469     }
 470
 471 foreign_key_def_begin : /constraint/i /foreign key/i
 472     { $return = '' }
 473     |
 474     /constraint/i WORD /foreign key/i
 475     { $return = $item[2] }
 476     |
 477     /foreign key/i
 478     { $return = '' }
 479
 480 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 481     {
 482         $return       = {
 483             supertype => 'constraint',
 484             name      => $item{'index_name(?)'}[0],
 485             type      => 'primary_key',
 486             fields    => $item[4],
 487         };
 488     }
 489
 490 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 491     {
 492         $return       = {
 493             supertype => 'constraint',
 494             name      => $item{'index_name(?)'}[0],
 495             type      => 'unique',
 496             fields    => $item[5],
 497         }
 498     }
 499
 500 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 501     {
 502         $return       = {
 503             supertype => 'index',
 504             type      => 'normal',
 505             name      => $item{'index_name(?)'}[0],
 506             fields    => $item[4],
 507         }
 508     }
 509
 510 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 511     {
 512         $return       = {
 513             supertype => 'index',
 514             type      => 'fulltext',
 515             name      => $item{'index_name(?)'}[0],
 516             fields    => $item[5],
 517         }
 518     }
 519
 520 name_with_opt_paren : NAME parens_value_list(s?)
 521     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 522
 523 UNIQUE : /unique/i { 1 }
 524
 525 KEY : /key/i | /index/i
 526
 527 table_option : WORD /\s*=\s*/ WORD
 528     {
 529         $return = { $item[1] => $item[3] };
 530     }
 531
 532 CREATE : /create/i
 533
 534 TEMPORARY : /temporary/i
 535
 536 TABLE : /table/i
 537
 538 WORD : /\w+/
 539
 540 DIGITS : /\d+/
 541
 542 COMMA : ','
 543
 544 NAME    : "`" /\w+/ "`"
 545     { $item[2] }
 546     | /\w+/
 547     { $item[1] }
 548
 549 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 550     { $item[1] }
 551     | /'.*?'/
 552     {
 553         # remove leading/trailing quotes
 554         my $val = $item[1];
 555         $val    =~ s/^['"]|['"]$//g;
 556         $return = $val;
 557     }
 558     | /NULL/
 559     { 'NULL' }
 560
 561 !;
 562
 563 # -------------------------------------------------------------------
 564 sub parse {
 565     my ( $translator, $data ) = @_;
 566     my $parser = Parse::RecDescent->new($GRAMMAR);
 567
 568     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 569     local $DEBUG       = $translator->debug;
 570
 571     unless (defined $parser) {
 572         return $translator->error("Error instantiating Parse::RecDescent ".
 573             "instance: Bad grammer");
 574     }
 575
 576     my $result = $parser->startrule($data);
 577     return $translator->error( "Parse failed." ) unless defined $result;
 578     warn Dumper( $result ) if $DEBUG;
 579
 580     my $schema = $translator->schema;
 581     my @tables = sort {
 582         $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
 583     } keys %{ $result };
 584
 585     for my $table_name ( @tables ) {
 586         my $tdata =  $result->{ $table_name };
 587         my $table =  $schema->add_table(
 588             name  => $tdata->{'table_name'},
 589         ) or die $schema->error;
 590
 591         $table->comments( $tdata->{'comments'} );
 592
 593         my @fields = sort {
 594             $tdata->{'fields'}->{$a}->{'order'}
 595             <=>
 596             $tdata->{'fields'}->{$b}->{'order'}
 597         } keys %{ $tdata->{'fields'} };
 598
 599         for my $fname ( @fields ) {
 600             my $fdata = $tdata->{'fields'}{ $fname };
 601             my $field = $table->add_field(
 602                 name              => $fdata->{'name'},
 603                 data_type         => $fdata->{'data_type'},
 604                 size              => $fdata->{'size'},
 605                 default_value     => $fdata->{'default'},
 606                 is_auto_increment => $fdata->{'is_auto_inc'},
 607                 is_nullable       => $fdata->{'null'},
 608                 comments          => $fdata->{'comments'},
 609             ) or die $table->error;
 610
 611             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 612
 613             for my $qual ( qw[ binary unsigned zerofill list ] ) {
 614                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 615                     next if ref $val eq 'ARRAY' && !@$val;
 616                     $field->extra( $qual, $val );
 617                 }
 618             }
 619
 620             if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 621                 my %extra = $field->extra;
 622                 my $longest = 0;
 623                 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 624                     $longest = $len if $len > $longest;
 625                 }
 626                 $field->size( $longest ) if $longest;
 627             }
 628
 629             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 630                 next unless $cdata->{'type'} eq 'foreign_key';
 631                 $cdata->{'fields'} ||= [ $field->name ];
 632                 push @{ $tdata->{'constraints'} }, $cdata;
 633             }
 634         }
 635
 636         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 637             my $index  =  $table->add_index(
 638                 name   => $idata->{'name'},
 639                 type   => uc $idata->{'type'},
 640                 fields => $idata->{'fields'},
 641             ) or die $table->error;
 642         }
 643
 644         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 645             $table->options( \@options ) or die $table->error;
 646         }
 647
 648         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 649             my $constraint       =  $table->add_constraint(
 650                 name             => $cdata->{'name'},
 651                 type             => $cdata->{'type'},
 652                 fields           => $cdata->{'fields'},
 653                 reference_table  => $cdata->{'reference_table'},
 654                 reference_fields => $cdata->{'reference_fields'},
 655                 match_type       => $cdata->{'match_type'} || '',
 656                 on_delete        => $cdata->{'on_delete_do'},
 657                 on_update        => $cdata->{'on_update_do'},
 658             ) or die $table->error;
 659         }
 660     }
 661
 662     return 1;
 663 }
 664
 665 1;
 666
 667 # -------------------------------------------------------------------
 668 # Where man is not nature is barren.
 669 # William Blake
 670 # -------------------------------------------------------------------
 671
 672 =pod
 673
 674 =head1 AUTHOR
 675
 676 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 677 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 678
 679 =head1 SEE ALSO
 680
 681 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 682
 683 =cut