lib/SQL/Translator/Parser/MySQL.pm

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