lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.58 2007-03-19 17:15:24 duality72 Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Parser::MySQL - parser for MySQL
  26
  27 =head1 SYNOPSIS
  28
  29   use SQL::Translator;
  30   use SQL::Translator::Parser::MySQL;
  31
  32   my $translator = SQL::Translator->new;
  33   $translator->parser("SQL::Translator::Parser::MySQL");
  34
  35 =head1 DESCRIPTION
  36
  37 The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
  38
  39 Here's the word from the MySQL site
  40 (http://www.mysql.com/doc/en/CREATE_TABLE.html):
  41
  42   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
  43   [table_options] [select_statement]
  44
  45   or
  46
  47   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
  48
  49   create_definition:
  50     col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
  51               [PRIMARY KEY] [reference_definition]
  52     or    PRIMARY KEY (index_col_name,...)
  53     or    KEY [index_name] (index_col_name,...)
  54     or    INDEX [index_name] (index_col_name,...)
  55     or    UNIQUE [INDEX] [index_name] (index_col_name,...)
  56     or    FULLTEXT [INDEX] [index_name] (index_col_name,...)
  57     or    [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
  58               [reference_definition]
  59     or    CHECK (expr)
  60
  61   type:
  62           TINYINT[(length)] [UNSIGNED] [ZEROFILL]
  63     or    SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
  64     or    MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
  65     or    INT[(length)] [UNSIGNED] [ZEROFILL]
  66     or    INTEGER[(length)] [UNSIGNED] [ZEROFILL]
  67     or    BIGINT[(length)] [UNSIGNED] [ZEROFILL]
  68     or    REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
  69     or    DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
  70     or    FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
  71     or    DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
  72     or    NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
  73     or    CHAR(length) [BINARY]
  74     or    VARCHAR(length) [BINARY]
  75     or    DATE
  76     or    TIME
  77     or    TIMESTAMP
  78     or    DATETIME
  79     or    TINYBLOB
  80     or    BLOB
  81     or    MEDIUMBLOB
  82     or    LONGBLOB
  83     or    TINYTEXT
  84     or    TEXT
  85     or    MEDIUMTEXT
  86     or    LONGTEXT
  87     or    ENUM(value1,value2,value3,...)
  88     or    SET(value1,value2,value3,...)
  89
  90   index_col_name:
  91           col_name [(length)]
  92
  93   reference_definition:
  94           REFERENCES tbl_name [(index_col_name,...)]
  95                      [MATCH FULL | MATCH PARTIAL]
  96                      [ON DELETE reference_option]
  97                      [ON UPDATE reference_option]
  98
  99   reference_option:
 100           RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
 101
 102   table_options:
 103           TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
 104   or      AUTO_INCREMENT = #
 105   or      AVG_ROW_LENGTH = #
 106   or      CHECKSUM = {0 | 1}
 107   or      COMMENT = "string"
 108   or      MAX_ROWS = #
 109   or      MIN_ROWS = #
 110   or      PACK_KEYS = {0 | 1 | DEFAULT}
 111   or      PASSWORD = "string"
 112   or      DELAY_KEY_WRITE = {0 | 1}
 113   or      ROW_FORMAT= { default | dynamic | fixed | compressed }
 114   or      RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=#  RAID_CHUNKSIZE=#
 115   or      UNION = (table_name,[table_name...])
 116   or      INSERT_METHOD= {NO | FIRST | LAST }
 117   or      DATA DIRECTORY="absolute path to directory"
 118   or      INDEX DIRECTORY="absolute path to directory"
 119
 120 A subset of the ALTER TABLE syntax that allows addition of foreign keys:
 121
 122   ALTER [IGNORE] TABLE tbl_name alter_specification [, alter_specification] ...
 123
 124   alter_specification:
 125           ADD [CONSTRAINT [symbol]]
 126           FOREIGN KEY [index_name] (index_col_name,...)
 127              [reference_definition]
 128
 129 A subset of INSERT that we ignore:
 130
 131   INSERT anything
 132
 133 =cut
 134
 135 use strict;
 136 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
 137 $VERSION = sprintf "%d.%02d", q$Revision: 1.58 $ =~ /(\d+)\.(\d+)/;
 138 $DEBUG   = 0 unless defined $DEBUG;
 139
 140 use Data::Dumper;
 141 use Parse::RecDescent;
 142 use Exporter;
 143 use base qw(Exporter);
 144
 145 @EXPORT_OK = qw(parse);
 146
 147 # Enable warnings within the Parse::RecDescent module.
 148 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
 149 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
 150 $::RD_HINT   = 1; # Give out hints to help fix problems.
 151
 152 use constant DEFAULT_PARSER_VERSION => 30000;
 153
 154 $GRAMMAR = << 'END_OF_GRAMMAR';
 155
 156 {
 157     my ( $database_name, %tables, $table_order, @table_comments, %views, $view_order, %procedures, $proc_order );
 158     my $delimiter = ';';
 159 }
 160
 161 #
 162 # The "eofile" rule makes the parser fail if any "statement" rule
 163 # fails.  Otherwise, the first successful match by a "statement"
 164 # won't cause the failure needed to know that the parse, as a whole,
 165 # failed. -ky
 166 #
 167 startrule : statement(s) eofile {
 168     { tables => \%tables, database_name => $database_name, views => \%views, procedures =>\%procedures }
 169 }
 170
 171 eofile : /^\Z/
 172
 173 statement : comment
 174     | use
 175     | set
 176     | drop
 177     | create
 178     | alter
 179     | insert
 180     | delimiter
 181     | empty_statement
 182     | <error>
 183
 184 use : /use/i WORD "$delimiter"
 185     {
 186         $database_name = $item[2];
 187         @table_comments = ();
 188     }
 189
 190 set : /set/i /[^;]+/ "$delimiter"
 191     { @table_comments = () }
 192
 193 drop : /drop/i TABLE /[^;]+/ "$delimiter"
 194
 195 drop : /drop/i WORD(s) "$delimiter"
 196     { @table_comments = () }
 197
 198 string :
 199   # MySQL strings, unlike common SQL strings, can be double-quoted or
 200   # single-quoted, and you can escape the delmiters by doubling (but only the
 201   # delimiter) or by backslashing.
 202
 203    /'(\\.|''|[^\\\'])*'/ |
 204    /"(\\.|""|[^\\\"])*"/
 205   # For reference, std sql str: /(?:(?:\')(?:[^\']*(?:(?:\'\')[^\']*)*)(?:\'))//
 206
 207 nonstring : /[^;\'"]+/
 208
 209 statement_body : (string | nonstring)(s?)
 210
 211 insert : /insert/i  statement_body "$delimiter"
 212
 213 delimiter : /delimiter/i /[\S]+/
 214         { $delimiter = $item[2] }
 215
 216 empty_statement : "$delimiter"
 217
 218 alter : ALTER TABLE table_name alter_specification(s /,/) "$delimiter"
 219     {
 220         my $table_name                       = $item{'table_name'};
 221     die "Cannot ALTER table '$table_name'; it does not exist"
 222         unless $tables{ $table_name };
 223         for my $definition ( @{ $item[4] } ) {
 224         $definition->{'extra'}->{'alter'} = 1;
 225         push @{ $tables{ $table_name }{'constraints'} }, $definition;
 226     }
 227     }
 228
 229 alter_specification : ADD foreign_key_def
 230     { $return = $item[2] }
 231
 232 create : CREATE /database/i WORD "$delimiter"
 233     { @table_comments = () }
 234
 235 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) "$delimiter"
 236     {
 237         my $table_name                       = $item{'table_name'};
 238         $tables{ $table_name }{'order'}      = ++$table_order;
 239         $tables{ $table_name }{'table_name'} = $table_name;
 240
 241         if ( @table_comments ) {
 242             $tables{ $table_name }{'comments'} = [ @table_comments ];
 243             @table_comments = ();
 244         }
 245
 246         my $i = 1;
 247         for my $definition ( @{ $item[7] } ) {
 248             if ( $definition->{'supertype'} eq 'field' ) {
 249                 my $field_name = $definition->{'name'};
 250                 $tables{ $table_name }{'fields'}{ $field_name } =
 251                     { %$definition, order => $i };
 252                 $i++;
 253
 254                 if ( $definition->{'is_primary_key'} ) {
 255                     push @{ $tables{ $table_name }{'constraints'} },
 256                         {
 257                             type   => 'primary_key',
 258                             fields => [ $field_name ],
 259                         }
 260                     ;
 261                 }
 262             }
 263             elsif ( $definition->{'supertype'} eq 'constraint' ) {
 264                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 265             }
 266             elsif ( $definition->{'supertype'} eq 'index' ) {
 267                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 268             }
 269         }
 270
 271         if ( my @options = @{ $item{'table_option(s?)'} } ) {
 272             for my $option ( @options ) {
 273                 my ( $key, $value ) = each %$option;
 274                 if ( $key eq 'comment' ) {
 275                     push @{ $tables{ $table_name }{'comments'} }, $value;
 276                 }
 277                 else {
 278                     push @{ $tables{ $table_name }{'table_options'} }, $option;
 279                 }
 280             }
 281         }
 282
 283         1;
 284     }
 285
 286 opt_if_not_exists : /if not exists/i
 287
 288 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' "$delimiter"
 289     {
 290         @table_comments = ();
 291         push @{ $tables{ $item{'table_name'} }{'indices'} },
 292             {
 293                 name   => $item[4],
 294                 type   => $item[2] ? 'unique' : 'normal',
 295                 fields => $item[8],
 296             }
 297         ;
 298     }
 299
 300 create : CREATE /trigger/i NAME not_delimiter "$delimiter"
 301         {
 302                 @table_comments = ();
 303         }
 304
 305 create : CREATE PROCEDURE NAME not_delimiter "$delimiter"
 306         {
 307                 @table_comments = ();
 308         my $func_name = $item[3];
 309         my $owner = '';
 310         my $sql = "$item[1] $item[2] $item[3] $item[4]";
 311
 312         $procedures{ $func_name }{'order'}  = ++$proc_order;
 313         $procedures{ $func_name }{'name'}   = $func_name;
 314         $procedures{ $func_name }{'owner'}  = $owner;
 315         $procedures{ $func_name }{'sql'}    = $sql;
 316         }
 317
 318 PROCEDURE : /procedure/i
 319         | /function/i
 320
 321 create : CREATE algorithm /view/i NAME not_delimiter "$delimiter"
 322         {
 323                 @table_comments = ();
 324         my $view_name = $item[4];
 325         my $sql = "$item[1] $item[2] $item[3] $item[4] $item[5]";
 326
 327         # Hack to strip database from function calls in SQL
 328         $sql =~ s#`\w+`\.(`\w+`\()##g;
 329
 330         $views{ $view_name }{'order'}  = ++$view_order;
 331         $views{ $view_name }{'name'}   = $view_name;
 332         $views{ $view_name }{'sql'}    = $sql;
 333         }
 334
 335 algorithm : /algorithm/i /=/ WORD
 336         {
 337                 $return = "$item[1]=$item[3]";
 338         }
 339
 340 not_delimiter : /.*?(?=$delimiter)/is
 341
 342 create_definition : constraint
 343     | index
 344     | field
 345     | comment
 346     | <error>
 347
 348 comment : /^\s*(?:#|-{2}).*\n/
 349     {
 350         my $comment =  $item[1];
 351         $comment    =~ s/^\s*(#|--)\s*//;
 352         $comment    =~ s/\s*$//;
 353         $return     = $comment;
 354     }
 355
 356 comment : /\/\*/ /.*?\*\//s
 357     {
 358         my $comment = $item[2];
 359         $comment = substr($comment, 0, -2);
 360         $comment    =~ s/^\s*|\s*$//g;
 361         $return = $comment;
 362     }
 363
 364 field_comment : /^\s*(?:#|-{2}).*\n/
 365     {
 366         my $comment =  $item[1];
 367         $comment    =~ s/^\s*(#|--)\s*//;
 368         $comment    =~ s/\s*$//;
 369         $return     = $comment;
 370     }
 371
 372
 373 field_comment2 : /comment/i /'.*?'/
 374     {
 375         my $comment = $item[2];
 376         $comment    =~ s/^'//;
 377         $comment    =~ s/'$//;
 378         $return     = $comment;
 379     }
 380
 381 blank : /\s*/
 382
 383 field : field_comment(s?) field_name data_type field_qualifier(s?) field_comment2(?) reference_definition(?) on_update(?) field_comment(s?)
 384     {
 385         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 386         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 387             $qualifiers{ $_ } = 1 for @type_quals;
 388         }
 389
 390         my $null = defined $qualifiers{'not_null'}
 391                    ? $qualifiers{'not_null'} : 1;
 392         delete $qualifiers{'not_null'};
 393
 394         my @comments = ( @{ $item[1] }, @{ $item[5] }, @{ $item[8] } );
 395
 396         $return = {
 397             supertype   => 'field',
 398             name        => $item{'field_name'},
 399             data_type   => $item{'data_type'}{'type'},
 400             size        => $item{'data_type'}{'size'},
 401             list        => $item{'data_type'}{'list'},
 402             null        => $null,
 403             constraints => $item{'reference_definition(?)'},
 404             comments    => [ @comments ],
 405             %qualifiers,
 406         }
 407     }
 408     | <error>
 409
 410 field_qualifier : not_null
 411     {
 412         $return = {
 413              null => $item{'not_null'},
 414         }
 415     }
 416
 417 field_qualifier : default_val
 418     {
 419         $return = {
 420              default => $item{'default_val'},
 421         }
 422     }
 423
 424 field_qualifier : auto_inc
 425     {
 426         $return = {
 427              is_auto_inc => $item{'auto_inc'},
 428         }
 429     }
 430
 431 field_qualifier : primary_key
 432     {
 433         $return = {
 434              is_primary_key => $item{'primary_key'},
 435         }
 436     }
 437
 438 field_qualifier : unsigned
 439     {
 440         $return = {
 441              is_unsigned => $item{'unsigned'},
 442         }
 443     }
 444
 445 field_qualifier : /character set/i WORD
 446     {
 447         $return = {
 448             'CHARACTER SET' => $item[2],
 449         }
 450     }
 451
 452 field_qualifier : /collate/i WORD
 453     {
 454         $return = {
 455             COLLATE => $item[2],
 456         }
 457     }
 458
 459 field_qualifier : /on update/i CURRENT_TIMESTAMP
 460     {
 461         $return = {
 462             'ON UPDATE' => $item[2],
 463         }
 464     }
 465
 466 field_qualifier : /unique/i KEY(?)
 467     {
 468         $return = {
 469             is_unique => 1,
 470         }
 471     }
 472
 473 field_qualifier : KEY
 474     {
 475         $return = {
 476             has_index => 1,
 477         }
 478     }
 479
 480 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
 481     {
 482         $return = {
 483             type             => 'foreign_key',
 484             reference_table  => $item[2],
 485             reference_fields => $item[3][0],
 486             match_type       => $item[4][0],
 487             on_delete        => $item[5][0],
 488             on_update        => $item[6][0],
 489         }
 490     }
 491
 492 match_type : /match full/i { 'full' }
 493     |
 494     /match partial/i { 'partial' }
 495
 496 on_delete : /on delete/i reference_option
 497     { $item[2] }
 498
 499 on_update :
 500     /on update/i 'CURRENT_TIMESTAMP'
 501     { $item[2] }
 502     |
 503     /on update/i reference_option
 504     { $item[2] }
 505
 506 reference_option: /restrict/i |
 507     /cascade/i   |
 508     /set null/i  |
 509     /no action/i |
 510     /set default/i
 511     { $item[1] }
 512
 513 index : normal_index
 514     | fulltext_index
 515     | <error>
 516
 517 table_name   : NAME
 518
 519 field_name   : NAME
 520
 521 index_name   : NAME
 522
 523 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 524     {
 525         my $type = $item[1];
 526         my $size; # field size, applicable only to non-set fields
 527         my $list; # set list, applicable only to sets (duh)
 528
 529         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 530             $size = undef;
 531             $list = $item[2][0];
 532         }
 533         else {
 534             $size = $item[2][0];
 535             $list = [];
 536         }
 537
 538         if ( @{ $size || [] } == 0 && !$thisparser->{local}{sqlt_parser_args}{no_default_sizes} ) {
 539             if ( lc $type eq 'tinyint' ) {
 540                 $size = 4;
 541             }
 542             elsif ( lc $type eq 'smallint' ) {
 543                 $size = 6;
 544             }
 545             elsif ( lc $type eq 'mediumint' ) {
 546                 $size = 9;
 547             }
 548             elsif ( $type =~ /^int(eger)?$/i ) {
 549                 $type = 'int';
 550                 $size = 11;
 551             }
 552             elsif ( lc $type eq 'bigint' ) {
 553                 $size = 20;
 554             }
 555             elsif (
 556                 lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/
 557             ) {
 558                 $size = [8,2];
 559             }
 560         }
 561
 562         if ( $type =~ /^tiny(text|blob)$/i ) {
 563             $size = 255;
 564         }
 565         elsif ( $type =~ /^(blob|text)$/i ) {
 566             $size = 65_535;
 567         }
 568         elsif ( $type =~ /^medium(blob|text)$/i ) {
 569             $size = 16_777_215;
 570         }
 571         elsif ( $type =~ /^long(blob|text)$/i ) {
 572             $size = 4_294_967_295;
 573         }
 574
 575         $return        = {
 576             type       => $type,
 577             size       => $size,
 578             list       => $list,
 579             qualifiers => $item[3],
 580         }
 581     }
 582
 583 parens_field_list : '(' field_name(s /,/) ')'
 584     { $item[2] }
 585
 586 parens_value_list : '(' VALUE(s /,/) ')'
 587     { $item[2] }
 588
 589 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 590     { lc $item[1] }
 591
 592 field_type   : WORD
 593
 594 create_index : /create/i /index/i
 595
 596 not_null     : /not/i /null/i
 597     { $return = 0 }
 598     |
 599     /null/i
 600     { $return = 1 }
 601
 602 unsigned     : /unsigned/i { $return = 0 }
 603
 604 #default_val  : /default/i /(?:')?[\s\w\d:.-]*(?:')?/
 605 #    {
 606 #        $item[2] =~ s/'//g;
 607 #        $return  =  $item[2];
 608 #    }
 609
 610 default_val :
 611     /default/i 'CURRENT_TIMESTAMP'
 612     {
 613         $return =  $item[2];
 614     }
 615     |
 616     /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
 617     {
 618         $item[2] =~ s/^\s*'|'\s*$//g;
 619         $return  =  $item[2];
 620     }
 621
 622 auto_inc : /auto_increment/i { 1 }
 623
 624 primary_key : /primary/i /key/i { 1 }
 625
 626 constraint : primary_key_def
 627     | unique_key_def
 628     | foreign_key_def
 629     | <error>
 630
 631 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 632     {
 633         $return              =  {
 634             supertype        => 'constraint',
 635             type             => 'foreign_key',
 636             name             => $item[1],
 637             fields           => $item[2],
 638             %{ $item{'reference_definition'} },
 639         }
 640     }
 641
 642 foreign_key_def_begin : /constraint/i /foreign key/i WORD
 643     { $return = $item[3] }
 644     |
 645     /constraint/i NAME /foreign key/i
 646     { $return = $item[2] }
 647     |
 648     /constraint/i /foreign key/i
 649     { $return = '' }
 650     |
 651     /foreign key/i WORD
 652     { $return = $item[2] }
 653     |
 654     /foreign key/i
 655     { $return = '' }
 656
 657 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 658     {
 659         $return       = {
 660             supertype => 'constraint',
 661             name      => $item{'index_name(?)'}[0],
 662             type      => 'primary_key',
 663             fields    => $item[4],
 664         };
 665     }
 666
 667 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 668     {
 669         $return       = {
 670             supertype => 'constraint',
 671             name      => $item{'index_name(?)'}[0],
 672             type      => 'unique',
 673             fields    => $item[5],
 674         }
 675     }
 676
 677 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 678     {
 679         $return       = {
 680             supertype => 'index',
 681             type      => 'normal',
 682             name      => $item{'index_name(?)'}[0],
 683             fields    => $item[4],
 684         }
 685     }
 686
 687 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 688     {
 689         $return       = {
 690             supertype => 'index',
 691             type      => 'fulltext',
 692             name      => $item{'index_name(?)'}[0],
 693             fields    => $item[5],
 694         }
 695     }
 696
 697 name_with_opt_paren : NAME parens_value_list(s?)
 698     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 699
 700 UNIQUE : /unique/i { 1 }
 701
 702 KEY : /key/i | /index/i
 703
 704 table_option : /comment/i /=/ /'.*?'/
 705     {
 706         my $comment = $item[3];
 707         $comment    =~ s/^'//;
 708         $comment    =~ s/'$//;
 709         $return     = { comment => $comment };
 710     }
 711     | /(default )?(charset|character set)/i /\s*=\s*/ WORD
 712     {
 713         $return = { 'CHARACTER SET' => $item[3] };
 714     }
 715     | WORD /\s*=\s*/ WORD
 716     {
 717         $return = { $item[1] => $item[3] };
 718     }
 719
 720 default : /default/i
 721
 722 ADD : /add/i
 723
 724 ALTER : /alter/i
 725
 726 CREATE : /create/i
 727
 728 TEMPORARY : /temporary/i
 729
 730 TABLE : /table/i
 731
 732 WORD : /\w+/
 733
 734 DIGITS : /\d+/
 735
 736 COMMA : ','
 737
 738 NAME    : "`" /\w+/ "`"
 739     { $item[2] }
 740     | /\w+/
 741     { $item[1] }
 742
 743 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 744     { $item[1] }
 745     | /'.*?'/
 746     {
 747         # remove leading/trailing quotes
 748         my $val = $item[1];
 749         $val    =~ s/^['"]|['"]$//g;
 750         $return = $val;
 751     }
 752     | /NULL/
 753     { 'NULL' }
 754
 755 CURRENT_TIMESTAMP : /current_timestamp(\(\))?/i
 756         | /now\(\)/i
 757         { 'CURRENT_TIMESTAMP' }
 758
 759 END_OF_GRAMMAR
 760
 761 # -------------------------------------------------------------------
 762 sub parse {
 763     my ( $translator, $data ) = @_;
 764     my $parser = Parse::RecDescent->new($GRAMMAR);
 765
 766     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 767     local $DEBUG       = $translator->debug;
 768
 769     unless (defined $parser) {
 770         return $translator->error("Error instantiating Parse::RecDescent ".
 771             "instance: Bad grammer");
 772     }
 773
 774     # This is the only way to get args into the productions/actions
 775     $parser->{local}{sqlt_parser_args} = $translator->parser_args;
 776
 777     # Preprocess for MySQL-specific and not-before-version comments from mysqldump
 778     my $parser_version = $translator->parser_args->{mysql_parser_version} || DEFAULT_PARSER_VERSION;
 779     while ( $data =~ s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es ) {}
 780
 781     my $result = $parser->startrule($data);
 782     return $translator->error( "Parse failed." ) unless defined $result;
 783     warn "Parse result:".Dumper( $result ) if $DEBUG;
 784
 785     my $schema = $translator->schema;
 786     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 787
 788     my @tables = sort {
 789         $result->{'tables'}{ $a }{'order'}
 790         <=>
 791         $result->{'tables'}{ $b }{'order'}
 792     } keys %{ $result->{'tables'} };
 793
 794     for my $table_name ( @tables ) {
 795         my $tdata =  $result->{tables}{ $table_name };
 796         my $table =  $schema->add_table(
 797             name  => $tdata->{'table_name'},
 798         ) or die $schema->error;
 799
 800         $table->comments( $tdata->{'comments'} );
 801
 802         my @fields = sort {
 803             $tdata->{'fields'}->{$a}->{'order'}
 804             <=>
 805             $tdata->{'fields'}->{$b}->{'order'}
 806         } keys %{ $tdata->{'fields'} };
 807
 808         for my $fname ( @fields ) {
 809             my $fdata = $tdata->{'fields'}{ $fname };
 810             my $field = $table->add_field(
 811                 name              => $fdata->{'name'},
 812                 data_type         => $fdata->{'data_type'},
 813                 size              => $fdata->{'size'},
 814                 default_value     => $fdata->{'default'},
 815                 is_auto_increment => $fdata->{'is_auto_inc'},
 816                 is_nullable       => $fdata->{'null'},
 817                 comments          => $fdata->{'comments'},
 818             ) or die $table->error;
 819
 820             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 821
 822             for my $qual ( qw[ binary unsigned zerofill list collate ],
 823                         'character set', 'on update' ) {
 824                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 825                     next if ref $val eq 'ARRAY' && !@$val;
 826                     $field->extra( $qual, $val );
 827                 }
 828             }
 829
 830             if ( $fdata->{'has_index'} ) {
 831                 $table->add_index(
 832                     name   => '',
 833                     type   => 'NORMAL',
 834                     fields => $fdata->{'name'},
 835                 ) or die $table->error;
 836             }
 837
 838             if ( $fdata->{'is_unique'} ) {
 839                 $table->add_constraint(
 840                     name   => '',
 841                     type   => 'UNIQUE',
 842                     fields => $fdata->{'name'},
 843                 ) or die $table->error;
 844             }
 845
 846             if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 847                 my %extra = $field->extra;
 848                 my $longest = 0;
 849                 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 850                     $longest = $len if $len > $longest;
 851                 }
 852                 $field->size( $longest ) if $longest;
 853             }
 854
 855             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 856                 next unless $cdata->{'type'} eq 'foreign_key';
 857                 $cdata->{'fields'} ||= [ $field->name ];
 858                 push @{ $tdata->{'constraints'} }, $cdata;
 859             }
 860         }
 861
 862         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 863             my $index  =  $table->add_index(
 864                 name   => $idata->{'name'},
 865                 type   => uc $idata->{'type'},
 866                 fields => $idata->{'fields'},
 867             ) or die $table->error;
 868         }
 869
 870         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 871             $table->options( \@options ) or die $table->error;
 872         }
 873
 874         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 875             my $constraint       =  $table->add_constraint(
 876                 name             => $cdata->{'name'},
 877                 type             => $cdata->{'type'},
 878                 fields           => $cdata->{'fields'},
 879                 reference_table  => $cdata->{'reference_table'},
 880                 reference_fields => $cdata->{'reference_fields'},
 881                 match_type       => $cdata->{'match_type'} || '',
 882                 on_delete        => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
 883                 on_update        => $cdata->{'on_update'} || $cdata->{'on_update_do'},
 884             ) or die $table->error;
 885         }
 886     }
 887
 888     my @procedures = sort {
 889         $result->{procedures}->{ $a }->{'order'} <=> $result->{procedures}->{ $b }->{'order'}
 890     } keys %{ $result->{procedures} };
 891     foreach my $proc_name (@procedures) {
 892         $schema->add_procedure(
 893                 name  => $proc_name,
 894                 owner => $result->{procedures}->{$proc_name}->{owner},
 895                 sql   => $result->{procedures}->{$proc_name}->{sql},
 896                 );
 897     }
 898
 899     my @views = sort {
 900         $result->{views}->{ $a }->{'order'} <=> $result->{views}->{ $b }->{'order'}
 901     } keys %{ $result->{views} };
 902     foreach my $view_name (keys %{ $result->{views} }) {
 903         $schema->add_view(
 904                 name => $view_name,
 905                 sql  => $result->{views}->{$view_name}->{sql},
 906                 );
 907     }
 908
 909     return 1;
 910 }
 911
 912 1;
 913
 914 # -------------------------------------------------------------------
 915 # Where man is not nature is barren.
 916 # William Blake
 917 # -------------------------------------------------------------------
 918
 919 =pod
 920
 921 =head1 AUTHOR
 922
 923 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
 924 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 925
 926 =head1 SEE ALSO
 927
 928 Parse::RecDescent, SQL::Translator::Schema.
 929
 930 =cut