lib/SQL/Translator/Parser/MySQL.pm

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