lib/SQL/Translator/Parser/MySQL.pm

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