lib/SQL/Translator/Parser/MySQL.pm

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