lib/SQL/Translator/Parser/MySQL.pm

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