lib/SQL/Translator/Parser/MySQL.pm

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