lib/SQL/Translator/Parser/MySQL.pm

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