lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.42 2004-01-25 18:09:51 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.42 $ =~ /(\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 default_val : /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
 452     {
 453         $item[2] =~ s/^\s*'|'\s*$//g;
 454         $return  =  $item[2];
 455     }
 456
 457 auto_inc : /auto_increment/i { 1 }
 458
 459 primary_key : /primary/i /key/i { 1 }
 460
 461 constraint : primary_key_def
 462     | unique_key_def
 463     | foreign_key_def
 464     | <error>
 465
 466 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 467     {
 468         $return              =  {
 469             supertype        => 'constraint',
 470             type             => 'foreign_key',
 471             name             => $item[1],
 472             fields           => $item[2],
 473             %{ $item{'reference_definition'} },
 474         }
 475     }
 476
 477 foreign_key_def_begin : /constraint/i /foreign key/i
 478     { $return = '' }
 479     |
 480     /constraint/i WORD /foreign key/i
 481     { $return = $item[2] }
 482     |
 483     /foreign key/i
 484     { $return = '' }
 485
 486 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 487     {
 488         $return       = {
 489             supertype => 'constraint',
 490             name      => $item{'index_name(?)'}[0],
 491             type      => 'primary_key',
 492             fields    => $item[4],
 493         };
 494     }
 495
 496 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 497     {
 498         $return       = {
 499             supertype => 'constraint',
 500             name      => $item{'index_name(?)'}[0],
 501             type      => 'unique',
 502             fields    => $item[5],
 503         }
 504     }
 505
 506 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 507     {
 508         $return       = {
 509             supertype => 'index',
 510             type      => 'normal',
 511             name      => $item{'index_name(?)'}[0],
 512             fields    => $item[4],
 513         }
 514     }
 515
 516 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 517     {
 518         $return       = {
 519             supertype => 'index',
 520             type      => 'fulltext',
 521             name      => $item{'index_name(?)'}[0],
 522             fields    => $item[5],
 523         }
 524     }
 525
 526 name_with_opt_paren : NAME parens_value_list(s?)
 527     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 528
 529 UNIQUE : /unique/i { 1 }
 530
 531 KEY : /key/i | /index/i
 532
 533 table_option : WORD /\s*=\s*/ WORD
 534     {
 535         $return = { $item[1] => $item[3] };
 536     }
 537
 538 CREATE : /create/i
 539
 540 TEMPORARY : /temporary/i
 541
 542 TABLE : /table/i
 543
 544 WORD : /\w+/
 545
 546 DIGITS : /\d+/
 547
 548 COMMA : ','
 549
 550 NAME    : "`" /\w+/ "`"
 551     { $item[2] }
 552     | /\w+/
 553     { $item[1] }
 554
 555 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 556     { $item[1] }
 557     | /'.*?'/
 558     {
 559         # remove leading/trailing quotes
 560         my $val = $item[1];
 561         $val    =~ s/^['"]|['"]$//g;
 562         $return = $val;
 563     }
 564     | /NULL/
 565     { 'NULL' }
 566
 567 !;
 568
 569 # -------------------------------------------------------------------
 570 sub parse {
 571     my ( $translator, $data ) = @_;
 572     my $parser = Parse::RecDescent->new($GRAMMAR);
 573
 574     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 575     local $DEBUG       = $translator->debug;
 576
 577     unless (defined $parser) {
 578         return $translator->error("Error instantiating Parse::RecDescent ".
 579             "instance: Bad grammer");
 580     }
 581
 582     my $result = $parser->startrule($data);
 583     return $translator->error( "Parse failed." ) unless defined $result;
 584     warn Dumper( $result ) if $DEBUG;
 585
 586     my $schema = $translator->schema;
 587     my @tables = sort {
 588         $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
 589     } keys %{ $result };
 590
 591     for my $table_name ( @tables ) {
 592         my $tdata =  $result->{ $table_name };
 593         my $table =  $schema->add_table(
 594             name  => $tdata->{'table_name'},
 595         ) or die $schema->error;
 596
 597         $table->comments( $tdata->{'comments'} );
 598
 599         my @fields = sort {
 600             $tdata->{'fields'}->{$a}->{'order'}
 601             <=>
 602             $tdata->{'fields'}->{$b}->{'order'}
 603         } keys %{ $tdata->{'fields'} };
 604
 605         for my $fname ( @fields ) {
 606             my $fdata = $tdata->{'fields'}{ $fname };
 607             my $field = $table->add_field(
 608                 name              => $fdata->{'name'},
 609                 data_type         => $fdata->{'data_type'},
 610                 size              => $fdata->{'size'},
 611                 default_value     => $fdata->{'default'},
 612                 is_auto_increment => $fdata->{'is_auto_inc'},
 613                 is_nullable       => $fdata->{'null'},
 614                 comments          => $fdata->{'comments'},
 615             ) or die $table->error;
 616
 617             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 618
 619             for my $qual ( qw[ binary unsigned zerofill list ] ) {
 620                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 621                     next if ref $val eq 'ARRAY' && !@$val;
 622                     $field->extra( $qual, $val );
 623                 }
 624             }
 625
 626             if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 627                 my %extra = $field->extra;
 628                 my $longest = 0;
 629                 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 630                     $longest = $len if $len > $longest;
 631                 }
 632                 $field->size( $longest ) if $longest;
 633             }
 634
 635             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 636                 next unless $cdata->{'type'} eq 'foreign_key';
 637                 $cdata->{'fields'} ||= [ $field->name ];
 638                 push @{ $tdata->{'constraints'} }, $cdata;
 639             }
 640         }
 641
 642         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 643             my $index  =  $table->add_index(
 644                 name   => $idata->{'name'},
 645                 type   => uc $idata->{'type'},
 646                 fields => $idata->{'fields'},
 647             ) or die $table->error;
 648         }
 649
 650         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 651             $table->options( \@options ) or die $table->error;
 652         }
 653
 654         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 655             my $constraint       =  $table->add_constraint(
 656                 name             => $cdata->{'name'},
 657                 type             => $cdata->{'type'},
 658                 fields           => $cdata->{'fields'},
 659                 reference_table  => $cdata->{'reference_table'},
 660                 reference_fields => $cdata->{'reference_fields'},
 661                 match_type       => $cdata->{'match_type'} || '',
 662                 on_delete        => $cdata->{'on_delete_do'},
 663                 on_update        => $cdata->{'on_update_do'},
 664             ) or die $table->error;
 665         }
 666     }
 667
 668     return 1;
 669 }
 670
 671 1;
 672
 673 # -------------------------------------------------------------------
 674 # Where man is not nature is barren.
 675 # William Blake
 676 # -------------------------------------------------------------------
 677
 678 =pod
 679
 680 =head1 AUTHOR
 681
 682 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 683 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 684
 685 =head1 SEE ALSO
 686
 687 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 688
 689 =cut