lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.47 2005-06-10 18:12:37 kycl4rk 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.47 $ =~ /(\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 $GRAMMAR = q!
 153
 154 {
 155     my ( $database_name, %tables, $table_order, @table_comments );
 156 }
 157
 158 #
 159 # The "eofile" rule makes the parser fail if any "statement" rule
 160 # fails.  Otherwise, the first successful match by a "statement"
 161 # won't cause the failure needed to know that the parse, as a whole,
 162 # failed. -ky
 163 #
 164 startrule : statement(s) eofile {
 165     { tables => \%tables, database_name => $database_name }
 166 }
 167
 168 eofile : /^\Z/
 169
 170 statement : comment
 171     | use
 172     | set
 173     | drop
 174     | create
 175     | alter
 176     | insert
 177     | <error>
 178
 179 use : /use/i WORD ';'
 180     {
 181         $database_name = $item[2];
 182         @table_comments = ();
 183     }
 184
 185 set : /set/i /[^;]+/ ';'
 186     { @table_comments = () }
 187
 188 drop : /drop/i TABLE /[^;]+/ ';'
 189
 190 drop : /drop/i WORD(s) ';'
 191     { @table_comments = () }
 192
 193 insert : /insert/i  /[^;]+/ ';'
 194
 195 alter : ALTER TABLE table_name alter_specification(s /,/) ';'
 196     {
 197         my $table_name                       = $item{'table_name'};
 198     die "Cannot ALTER table '$table_name'; it does not exist"
 199         unless $tables{ $table_name };
 200         for my $definition ( @{ $item[4] } ) {
 201         $definition->{'extra'}->{'alter'} = 1;
 202         push @{ $tables{ $table_name }{'constraints'} }, $definition;
 203     }
 204     }
 205
 206 alter_specification : ADD foreign_key_def
 207     { $return = $item[2] }
 208
 209 create : CREATE /database/i WORD ';'
 210     { @table_comments = () }
 211
 212 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) ';'
 213     {
 214         my $table_name                       = $item{'table_name'};
 215         $tables{ $table_name }{'order'}      = ++$table_order;
 216         $tables{ $table_name }{'table_name'} = $table_name;
 217
 218         if ( @table_comments ) {
 219             $tables{ $table_name }{'comments'} = [ @table_comments ];
 220             @table_comments = ();
 221         }
 222
 223         my $i = 1;
 224         for my $definition ( @{ $item[7] } ) {
 225             if ( $definition->{'supertype'} eq 'field' ) {
 226                 my $field_name = $definition->{'name'};
 227                 $tables{ $table_name }{'fields'}{ $field_name } =
 228                     { %$definition, order => $i };
 229                 $i++;
 230
 231                 if ( $definition->{'is_primary_key'} ) {
 232                     push @{ $tables{ $table_name }{'constraints'} },
 233                         {
 234                             type   => 'primary_key',
 235                             fields => [ $field_name ],
 236                         }
 237                     ;
 238                 }
 239             }
 240             elsif ( $definition->{'supertype'} eq 'constraint' ) {
 241                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 242             }
 243             elsif ( $definition->{'supertype'} eq 'index' ) {
 244                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 245             }
 246         }
 247
 248         if ( my @options = @{ $item{'table_option(s?)'} } ) {
 249             $tables{ $table_name }{'table_options'} = \@options;
 250         }
 251
 252         1;
 253     }
 254
 255 opt_if_not_exists : /if not exists/i
 256
 257 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
 258     {
 259         @table_comments = ();
 260         push @{ $tables{ $item{'table_name'} }{'indices'} },
 261             {
 262                 name   => $item[4],
 263                 type   => $item[2] ? 'unique' : 'normal',
 264                 fields => $item[8],
 265             }
 266         ;
 267     }
 268
 269 create_definition : constraint
 270     | index
 271     | field
 272     | comment
 273     | <error>
 274
 275 comment : /^\s*(?:#|-{2}).*\n/
 276     {
 277         my $comment =  $item[1];
 278         $comment    =~ s/^\s*(#|--)\s*//;
 279         $comment    =~ s/\s*$//;
 280         $return     = $comment;
 281         push @table_comments, $comment;
 282     }
 283
 284 comment : /\/\*/ /[^\*]+/ /\*\// ';'
 285     {
 286         my $comment = $item[2];
 287         $comment    =~ s/^\s*|\s*$//g;
 288         $return = $comment;
 289     }
 290
 291 field_comment : /^\s*(?:#|-{2}).*\n/
 292     {
 293         my $comment =  $item[1];
 294         $comment    =~ s/^\s*(#|--)\s*//;
 295         $comment    =~ s/\s*$//;
 296         $return     = $comment;
 297     }
 298
 299 blank : /\s*/
 300
 301 field : field_comment(s?) field_name data_type field_qualifier(s?) reference_definition(?) on_update_do(?) field_comment(s?)
 302     {
 303         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 304         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 305             $qualifiers{ $_ } = 1 for @type_quals;
 306         }
 307
 308         my $null = defined $qualifiers{'not_null'}
 309                    ? $qualifiers{'not_null'} : 1;
 310         delete $qualifiers{'not_null'};
 311
 312         my @comments = ( @{ $item[1] }, @{ $item[6] } );
 313
 314         $return = {
 315             supertype   => 'field',
 316             name        => $item{'field_name'},
 317             data_type   => $item{'data_type'}{'type'},
 318             size        => $item{'data_type'}{'size'},
 319             list        => $item{'data_type'}{'list'},
 320             null        => $null,
 321             constraints => $item{'reference_definition(?)'},
 322             comments    => [ @comments ],
 323             %qualifiers,
 324         }
 325     }
 326     | <error>
 327
 328 field_qualifier : not_null
 329     {
 330         $return = {
 331              null => $item{'not_null'},
 332         }
 333     }
 334
 335 field_qualifier : default_val
 336     {
 337         $return = {
 338              default => $item{'default_val'},
 339         }
 340     }
 341
 342 field_qualifier : auto_inc
 343     {
 344         $return = {
 345              is_auto_inc => $item{'auto_inc'},
 346         }
 347     }
 348
 349 field_qualifier : primary_key
 350     {
 351         $return = {
 352              is_primary_key => $item{'primary_key'},
 353         }
 354     }
 355
 356 field_qualifier : unsigned
 357     {
 358         $return = {
 359              is_unsigned => $item{'unsigned'},
 360         }
 361     }
 362
 363 field_qualifier : /character set/i WORD
 364     {
 365         $return = {
 366             character_set => $item[2],
 367         }
 368     }
 369
 370 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 371     {
 372         $return = {
 373             type             => 'foreign_key',
 374             reference_table  => $item[2],
 375             reference_fields => $item[3][0],
 376             match_type       => $item[4][0],
 377             on_delete_do     => $item[5][0],
 378             on_update_do     => $item[6][0],
 379         }
 380     }
 381
 382 match_type : /match full/i { 'full' }
 383     |
 384     /match partial/i { 'partial' }
 385
 386 on_delete_do : /on delete/i reference_option
 387     { $item[2] }
 388
 389 on_update_do :
 390     /on update/i 'CURRENT_TIMESTAMP'
 391     { $item[2] }
 392     |
 393     /on update/i reference_option
 394     { $item[2] }
 395
 396 reference_option: /restrict/i |
 397     /cascade/i   |
 398     /set null/i  |
 399     /no action/i |
 400     /set default/i
 401     { $item[1] }
 402
 403 index : normal_index
 404     | fulltext_index
 405     | <error>
 406
 407 table_name   : NAME
 408
 409 field_name   : NAME
 410
 411 index_name   : NAME
 412
 413 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 414     {
 415         my $type = $item[1];
 416         my $size; # field size, applicable only to non-set fields
 417         my $list; # set list, applicable only to sets (duh)
 418
 419         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 420             $size = undef;
 421             $list = $item[2][0];
 422         }
 423         else {
 424             $size = $item[2][0];
 425             $list = [];
 426         }
 427
 428         unless ( @{ $size || [] } ) {
 429             if ( lc $type eq 'tinyint' ) {
 430                 $size = 4;
 431             }
 432             elsif ( lc $type eq 'smallint' ) {
 433                 $size = 6;
 434             }
 435             elsif ( lc $type eq 'mediumint' ) {
 436                 $size = 9;
 437             }
 438             elsif ( $type =~ /^int(eger)?$/i ) {
 439                 $type = 'int';
 440                 $size = 11;
 441             }
 442             elsif ( lc $type eq 'bigint' ) {
 443                 $size = 20;
 444             }
 445             elsif (
 446                 lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/
 447             ) {
 448                 $size = [8,2];
 449             }
 450         }
 451
 452         if ( $type =~ /^tiny(text|blob)$/i ) {
 453             $size = 255;
 454         }
 455         elsif ( $type =~ /^(blob|text)$/i ) {
 456             $size = 65_535;
 457         }
 458         elsif ( $type =~ /^medium(blob|text)$/i ) {
 459             $size = 16_777_215;
 460         }
 461         elsif ( $type =~ /^long(blob|text)$/i ) {
 462             $size = 4_294_967_295;
 463         }
 464
 465         $return        = {
 466             type       => $type,
 467             size       => $size,
 468             list       => $list,
 469             qualifiers => $item[3],
 470         }
 471     }
 472
 473 parens_field_list : '(' field_name(s /,/) ')'
 474     { $item[2] }
 475
 476 parens_value_list : '(' VALUE(s /,/) ')'
 477     { $item[2] }
 478
 479 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 480     { lc $item[1] }
 481
 482 field_type   : WORD
 483
 484 create_index : /create/i /index/i
 485
 486 not_null     : /not/i /null/i
 487     { $return = 0 }
 488     |
 489     /null/i
 490     { $return = 1 }
 491
 492 unsigned     : /unsigned/i { $return = 0 }
 493
 494 #default_val  : /default/i /(?:')?[\s\w\d:.-]*(?:')?/
 495 #    {
 496 #        $item[2] =~ s/'//g;
 497 #        $return  =  $item[2];
 498 #    }
 499
 500 default_val :
 501     /default/i 'CURRENT_TIMESTAMP'
 502     {
 503         $return =  $item[2];
 504     }
 505     |
 506     /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
 507     {
 508         $item[2] =~ s/^\s*'|'\s*$//g;
 509         $return  =  $item[2];
 510     }
 511
 512 auto_inc : /auto_increment/i { 1 }
 513
 514 primary_key : /primary/i /key/i { 1 }
 515
 516 constraint : primary_key_def
 517     | unique_key_def
 518     | foreign_key_def
 519     | <error>
 520
 521 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 522     {
 523         $return              =  {
 524             supertype        => 'constraint',
 525             type             => 'foreign_key',
 526             name             => $item[1],
 527             fields           => $item[2],
 528             %{ $item{'reference_definition'} },
 529         }
 530     }
 531
 532 foreign_key_def_begin : /constraint/i /foreign key/i WORD
 533     { $return = $item[3] }
 534     |
 535     /constraint/i NAME /foreign key/i
 536     { $return = $item[2] }
 537     |
 538     /constraint/i /foreign key/i
 539     { $return = '' }
 540     |
 541     /foreign key/i WORD
 542     { $return = $item[2] }
 543     |
 544     /foreign key/i
 545     { $return = '' }
 546
 547 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 548     {
 549         $return       = {
 550             supertype => 'constraint',
 551             name      => $item{'index_name(?)'}[0],
 552             type      => 'primary_key',
 553             fields    => $item[4],
 554         };
 555     }
 556
 557 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 558     {
 559         $return       = {
 560             supertype => 'constraint',
 561             name      => $item{'index_name(?)'}[0],
 562             type      => 'unique',
 563             fields    => $item[5],
 564         }
 565     }
 566
 567 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 568     {
 569         $return       = {
 570             supertype => 'index',
 571             type      => 'normal',
 572             name      => $item{'index_name(?)'}[0],
 573             fields    => $item[4],
 574         }
 575     }
 576
 577 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 578     {
 579         $return       = {
 580             supertype => 'index',
 581             type      => 'fulltext',
 582             name      => $item{'index_name(?)'}[0],
 583             fields    => $item[5],
 584         }
 585     }
 586
 587 name_with_opt_paren : NAME parens_value_list(s?)
 588     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 589
 590 UNIQUE : /unique/i { 1 }
 591
 592 KEY : /key/i | /index/i
 593
 594 table_option : 'DEFAULT CHARSET' /\s*=\s*/ WORD
 595     {
 596         $return = { $item[1] => $item[3] };
 597     }
 598     | WORD /\s*=\s*/ WORD
 599     {
 600         $return = { $item[1] => $item[3] };
 601     }
 602
 603 ADD : /add/i
 604
 605 ALTER : /alter/i
 606
 607 CREATE : /create/i
 608
 609 TEMPORARY : /temporary/i
 610
 611 TABLE : /table/i
 612
 613 WORD : /\w+/
 614
 615 DIGITS : /\d+/
 616
 617 COMMA : ','
 618
 619 NAME    : "`" /\w+/ "`"
 620     { $item[2] }
 621     | /\w+/
 622     { $item[1] }
 623
 624 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 625     { $item[1] }
 626     | /'.*?'/
 627     {
 628         # remove leading/trailing quotes
 629         my $val = $item[1];
 630         $val    =~ s/^['"]|['"]$//g;
 631         $return = $val;
 632     }
 633     | /NULL/
 634     { 'NULL' }
 635
 636 !;
 637
 638 # -------------------------------------------------------------------
 639 sub parse {
 640     my ( $translator, $data ) = @_;
 641     my $parser = Parse::RecDescent->new($GRAMMAR);
 642
 643     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 644     local $DEBUG       = $translator->debug;
 645
 646     unless (defined $parser) {
 647         return $translator->error("Error instantiating Parse::RecDescent ".
 648             "instance: Bad grammer");
 649     }
 650
 651     my $result = $parser->startrule($data);
 652     return $translator->error( "Parse failed." ) unless defined $result;
 653     warn "Parse result:".Dumper( $result ) if $DEBUG;
 654
 655     my $schema = $translator->schema;
 656     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 657
 658     my @tables = sort {
 659         $result->{'tables'}{ $a }{'order'}
 660         <=>
 661         $result->{'tables'}{ $b }{'order'}
 662     } keys %{ $result->{'tables'} };
 663
 664     for my $table_name ( @tables ) {
 665         my $tdata =  $result->{tables}{ $table_name };
 666         my $table =  $schema->add_table(
 667             name  => $tdata->{'table_name'},
 668         ) or die $schema->error;
 669
 670         $table->comments( $tdata->{'comments'} );
 671
 672         my @fields = sort {
 673             $tdata->{'fields'}->{$a}->{'order'}
 674             <=>
 675             $tdata->{'fields'}->{$b}->{'order'}
 676         } keys %{ $tdata->{'fields'} };
 677
 678         for my $fname ( @fields ) {
 679             my $fdata = $tdata->{'fields'}{ $fname };
 680             my $field = $table->add_field(
 681                 name              => $fdata->{'name'},
 682                 data_type         => $fdata->{'data_type'},
 683                 size              => $fdata->{'size'},
 684                 default_value     => $fdata->{'default'},
 685                 is_auto_increment => $fdata->{'is_auto_inc'},
 686                 is_nullable       => $fdata->{'null'},
 687                 comments          => $fdata->{'comments'},
 688             ) or die $table->error;
 689
 690             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 691
 692             for my $qual ( qw[ binary unsigned zerofill list ] ) {
 693                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 694                     next if ref $val eq 'ARRAY' && !@$val;
 695                     $field->extra( $qual, $val );
 696                 }
 697             }
 698
 699             if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 700                 my %extra = $field->extra;
 701                 my $longest = 0;
 702                 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 703                     $longest = $len if $len > $longest;
 704                 }
 705                 $field->size( $longest ) if $longest;
 706             }
 707
 708             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 709                 next unless $cdata->{'type'} eq 'foreign_key';
 710                 $cdata->{'fields'} ||= [ $field->name ];
 711                 push @{ $tdata->{'constraints'} }, $cdata;
 712             }
 713         }
 714
 715         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 716             my $index  =  $table->add_index(
 717                 name   => $idata->{'name'},
 718                 type   => uc $idata->{'type'},
 719                 fields => $idata->{'fields'},
 720             ) or die $table->error;
 721         }
 722
 723         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 724             $table->options( \@options ) or die $table->error;
 725         }
 726
 727         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 728             my $constraint       =  $table->add_constraint(
 729                 name             => $cdata->{'name'},
 730                 type             => $cdata->{'type'},
 731                 fields           => $cdata->{'fields'},
 732                 reference_table  => $cdata->{'reference_table'},
 733                 reference_fields => $cdata->{'reference_fields'},
 734                 match_type       => $cdata->{'match_type'} || '',
 735                 on_delete        => $cdata->{'on_delete_do'},
 736                 on_update        => $cdata->{'on_update_do'},
 737             ) or die $table->error;
 738         }
 739     }
 740
 741     return 1;
 742 }
 743
 744 1;
 745
 746 # -------------------------------------------------------------------
 747 # Where man is not nature is barren.
 748 # William Blake
 749 # -------------------------------------------------------------------
 750
 751 =pod
 752
 753 =head1 AUTHOR
 754
 755 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 756 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 757
 758 =head1 SEE ALSO
 759
 760 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 761
 762 =cut