lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.30 2003-08-16 13:20:06 rossta 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.30 $ =~ /(\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 ( lc $type =~ /(float|double|decimal|numeric|real)/ ) {
 389                 $size = [8,2];
 390             }
 391         }
 392
 393         $return        = {
 394             type       => $type,
 395             size       => $size,
 396             list       => $list,
 397             qualifiers => $item[3],
 398         }
 399     }
 400
 401 parens_field_list : '(' field_name(s /,/) ')'
 402     { $item[2] }
 403
 404 parens_value_list : '(' VALUE(s /,/) ')'
 405     { $item[2] }
 406
 407 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 408     { lc $item[1] }
 409
 410 field_type   : WORD
 411
 412 create_index : /create/i /index/i
 413
 414 not_null     : /not/i /null/i { $return = 0 }
 415
 416 unsigned     : /unsigned/i { $return = 0 }
 417
 418 default_val  : /default/i /(?:')?[\w\d:.-]*(?:')?/
 419     {
 420         $item[2] =~ s/'//g;
 421         $return  =  $item[2];
 422     }
 423
 424 auto_inc : /auto_increment/i { 1 }
 425
 426 primary_key : /primary/i /key/i { 1 }
 427
 428 constraint : primary_key_def
 429     | unique_key_def
 430     | foreign_key_def
 431     | <error>
 432
 433 foreign_key_def : opt_constraint(?) /foreign key/i WORD(?) parens_field_list reference_definition
 434     {
 435         $return              =  {
 436             supertype        => 'constraint',
 437             type             => 'foreign_key',
 438             name             => $item[3][0],
 439             fields           => $item[4],
 440             %{ $item{'reference_definition'} },
 441         }
 442     }
 443
 444 opt_constraint : /constraint/i WORD
 445
 446 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 447     {
 448         $return       = {
 449             supertype => 'constraint',
 450             name      => $item{'index_name(?)'}[0],
 451             type      => 'primary_key',
 452             fields    => $item[4],
 453         };
 454     }
 455
 456 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 457     {
 458         $return       = {
 459             supertype => 'constraint',
 460             name      => $item{'index_name(?)'}[0],
 461             type      => 'unique',
 462             fields    => $item[5],
 463         }
 464     }
 465
 466 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 467     {
 468         $return       = {
 469             supertype => 'index',
 470             type      => 'normal',
 471             name      => $item{'index_name(?)'}[0],
 472             fields    => $item[4],
 473         }
 474     }
 475
 476 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 477     {
 478         $return       = {
 479             supertype => 'index',
 480             type      => 'fulltext',
 481             name      => $item{'index_name(?)'}[0],
 482             fields    => $item[5],
 483         }
 484     }
 485
 486 name_with_opt_paren : NAME parens_value_list(s?)
 487     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 488
 489 UNIQUE : /unique/i { 1 }
 490
 491 KEY : /key/i | /index/i
 492
 493 table_option : /[^\s;]*/
 494     {
 495         $return = { split /=/, $item[1] }
 496     }
 497
 498 CREATE : /create/i
 499
 500 TEMPORARY : /temporary/i
 501
 502 TABLE : /table/i
 503
 504 WORD : /\w+/
 505
 506 DIGITS : /\d+/
 507
 508 COMMA : ','
 509
 510 NAME    : "`" /\w+/ "`"
 511     { $item[2] }
 512     | /\w+/
 513     { $item[1] }
 514
 515 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 516     { $item[1] }
 517     | /'.*?'/
 518     {
 519         # remove leading/trailing quotes
 520         my $val = $item[1];
 521         $val    =~ s/^['"]|['"]$//g;
 522         $return = $val;
 523     }
 524     | /NULL/
 525     { 'NULL' }
 526
 527 !;
 528
 529 # -------------------------------------------------------------------
 530 sub parse {
 531     my ( $translator, $data ) = @_;
 532     my $parser = Parse::RecDescent->new($GRAMMAR);
 533
 534     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 535     local $DEBUG       = $translator->debug;
 536
 537     unless (defined $parser) {
 538         return $translator->error("Error instantiating Parse::RecDescent ".
 539             "instance: Bad grammer");
 540     }
 541
 542     my $result = $parser->startrule($data);
 543     return $translator->error( "Parse failed." ) unless defined $result;
 544     warn Dumper( $result ) if $DEBUG;
 545
 546     my $schema = $translator->schema;
 547     my @tables = sort {
 548         $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
 549     } keys %{ $result };
 550
 551     for my $table_name ( @tables ) {
 552         my $tdata =  $result->{ $table_name };
 553         my $table =  $schema->add_table(
 554             name  => $tdata->{'table_name'},
 555         ) or die $schema->error;
 556
 557 #        for my $opt ( @{ $tdata->{'table_options'} } ) {
 558 #            if ( my ( $key, $val ) = each %$opt ) {
 559 #                $tables->options(
 560 #            }
 561 #        }
 562
 563         my @fields = sort {
 564             $tdata->{'fields'}->{$a}->{'order'}
 565             <=>
 566             $tdata->{'fields'}->{$b}->{'order'}
 567         } keys %{ $tdata->{'fields'} };
 568
 569         for my $fname ( @fields ) {
 570             my $fdata = $tdata->{'fields'}{ $fname };
 571             my $field = $table->add_field(
 572                 name              => $fdata->{'name'},
 573                 data_type         => $fdata->{'data_type'},
 574                 size              => $fdata->{'size'},
 575                 default_value     => $fdata->{'default'},
 576                 is_auto_increment => $fdata->{'is_auto_inc'},
 577                 is_nullable       => $fdata->{'null'},
 578                 comments          => $fdata->{'comments'},
 579             ) or die $table->error;
 580
 581             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 582
 583             for my $qual ( qw[ binary unsigned zerofill list ] ) {
 584                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 585                     next if ref $val eq 'ARRAY' && !@$val;
 586                     $field->extra( $qual, $val );
 587                 }
 588             }
 589
 590             if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 591                 my %extra = $field->extra;
 592                 my $longest;
 593                 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 594                     $longest = $len if $len > $longest;
 595                 }
 596                 $field->size( $longest ) if $longest;
 597             }
 598
 599             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 600                 next unless $cdata->{'type'} eq 'foreign_key';
 601                 $cdata->{'fields'} ||= [ $field->name ];
 602                 push @{ $tdata->{'constraints'} }, $cdata;
 603             }
 604         }
 605
 606         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 607             my $index  =  $table->add_index(
 608                 name   => $idata->{'name'},
 609                 type   => uc $idata->{'type'},
 610                 fields => $idata->{'fields'},
 611             ) or die $table->error;
 612         }
 613
 614         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 615             my $constraint       =  $table->add_constraint(
 616                 name             => $cdata->{'name'},
 617                 type             => $cdata->{'type'},
 618                 fields           => $cdata->{'fields'},
 619                 reference_table  => $cdata->{'reference_table'},
 620                 reference_fields => $cdata->{'reference_fields'},
 621                 match_type       => $cdata->{'match_type'} || '',
 622                 on_delete        => $cdata->{'on_delete_do'},
 623                 on_update        => $cdata->{'on_update_do'},
 624             ) or die $table->error;
 625         }
 626     }
 627
 628     return 1;
 629 }
 630
 631 1;
 632
 633 # -------------------------------------------------------------------
 634 # Where man is not nature is barren.
 635 # William Blake
 636 # -------------------------------------------------------------------
 637
 638 =pod
 639
 640 =head1 AUTHOR
 641
 642 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 643 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 644
 645 =head1 SEE ALSO
 646
 647 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 648
 649 =cut