lib/SQL/Translator/Parser/MySQL.pm

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