lib/SQL/Translator/Parser/MySQL.pm

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