lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.46 2005-06-07 16:49:55 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.46 $ =~ /(\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(?) 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 : /on update/i reference_option
 390     { $item[2] }
 391
 392 reference_option: /restrict/i |
 393     /cascade/i   |
 394     /set null/i  |
 395     /no action/i |
 396     /set default/i
 397     { $item[1] }
 398
 399 index : normal_index
 400     | fulltext_index
 401     | <error>
 402
 403 table_name   : NAME
 404
 405 field_name   : NAME
 406
 407 index_name   : NAME
 408
 409 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 410     {
 411         my $type = $item[1];
 412         my $size; # field size, applicable only to non-set fields
 413         my $list; # set list, applicable only to sets (duh)
 414
 415         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 416             $size = undef;
 417             $list = $item[2][0];
 418         }
 419         else {
 420             $size = $item[2][0];
 421             $list = [];
 422         }
 423
 424         unless ( @{ $size || [] } ) {
 425             if ( lc $type eq 'tinyint' ) {
 426                 $size = 4;
 427             }
 428             elsif ( lc $type eq 'smallint' ) {
 429                 $size = 6;
 430             }
 431             elsif ( lc $type eq 'mediumint' ) {
 432                 $size = 9;
 433             }
 434             elsif ( $type =~ /^int(eger)?$/i ) {
 435                 $type = 'int';
 436                 $size = 11;
 437             }
 438             elsif ( lc $type eq 'bigint' ) {
 439                 $size = 20;
 440             }
 441             elsif (
 442                 lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/
 443             ) {
 444                 $size = [8,2];
 445             }
 446         }
 447
 448         if ( $type =~ /^tiny(text|blob)$/i ) {
 449             $size = 255;
 450         }
 451         elsif ( $type =~ /^(blob|text)$/i ) {
 452             $size = 65_535;
 453         }
 454         elsif ( $type =~ /^medium(blob|text)$/i ) {
 455             $size = 16_777_215;
 456         }
 457         elsif ( $type =~ /^long(blob|text)$/i ) {
 458             $size = 4_294_967_295;
 459         }
 460
 461         $return        = {
 462             type       => $type,
 463             size       => $size,
 464             list       => $list,
 465             qualifiers => $item[3],
 466         }
 467     }
 468
 469 parens_field_list : '(' field_name(s /,/) ')'
 470     { $item[2] }
 471
 472 parens_value_list : '(' VALUE(s /,/) ')'
 473     { $item[2] }
 474
 475 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 476     { lc $item[1] }
 477
 478 field_type   : WORD
 479
 480 create_index : /create/i /index/i
 481
 482 not_null     : /not/i /null/i
 483     { $return = 0 }
 484     |
 485     /null/i
 486     { $return = 1 }
 487
 488 unsigned     : /unsigned/i { $return = 0 }
 489
 490 #default_val  : /default/i /(?:')?[\s\w\d:.-]*(?:')?/
 491 #    {
 492 #        $item[2] =~ s/'//g;
 493 #        $return  =  $item[2];
 494 #    }
 495
 496 default_val : /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
 497     {
 498         $item[2] =~ s/^\s*'|'\s*$//g;
 499         $return  =  $item[2];
 500     }
 501
 502 auto_inc : /auto_increment/i { 1 }
 503
 504 primary_key : /primary/i /key/i { 1 }
 505
 506 constraint : primary_key_def
 507     | unique_key_def
 508     | foreign_key_def
 509     | <error>
 510
 511 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 512     {
 513         $return              =  {
 514             supertype        => 'constraint',
 515             type             => 'foreign_key',
 516             name             => $item[1],
 517             fields           => $item[2],
 518             %{ $item{'reference_definition'} },
 519         }
 520     }
 521
 522 foreign_key_def_begin : /constraint/i /foreign key/i WORD
 523     { $return = $item[3] }
 524     |
 525     /constraint/i NAME /foreign key/i
 526     { $return = $item[2] }
 527     |
 528     /constraint/i /foreign key/i
 529     { $return = '' }
 530     |
 531     /foreign key/i WORD
 532     { $return = $item[2] }
 533     |
 534     /foreign key/i
 535     { $return = '' }
 536
 537 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 538     {
 539         $return       = {
 540             supertype => 'constraint',
 541             name      => $item{'index_name(?)'}[0],
 542             type      => 'primary_key',
 543             fields    => $item[4],
 544         };
 545     }
 546
 547 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 548     {
 549         $return       = {
 550             supertype => 'constraint',
 551             name      => $item{'index_name(?)'}[0],
 552             type      => 'unique',
 553             fields    => $item[5],
 554         }
 555     }
 556
 557 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 558     {
 559         $return       = {
 560             supertype => 'index',
 561             type      => 'normal',
 562             name      => $item{'index_name(?)'}[0],
 563             fields    => $item[4],
 564         }
 565     }
 566
 567 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 568     {
 569         $return       = {
 570             supertype => 'index',
 571             type      => 'fulltext',
 572             name      => $item{'index_name(?)'}[0],
 573             fields    => $item[5],
 574         }
 575     }
 576
 577 name_with_opt_paren : NAME parens_value_list(s?)
 578     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 579
 580 UNIQUE : /unique/i { 1 }
 581
 582 KEY : /key/i | /index/i
 583
 584 table_option : 'DEFAULT CHARSET' /\s*=\s*/ WORD
 585     {
 586         $return = { $item[1] => $item[3] };
 587     }
 588     | WORD /\s*=\s*/ WORD
 589     {
 590         $return = { $item[1] => $item[3] };
 591     }
 592
 593 ADD : /add/i
 594
 595 ALTER : /alter/i
 596
 597 CREATE : /create/i
 598
 599 TEMPORARY : /temporary/i
 600
 601 TABLE : /table/i
 602
 603 WORD : /\w+/
 604
 605 DIGITS : /\d+/
 606
 607 COMMA : ','
 608
 609 NAME    : "`" /\w+/ "`"
 610     { $item[2] }
 611     | /\w+/
 612     { $item[1] }
 613
 614 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 615     { $item[1] }
 616     | /'.*?'/
 617     {
 618         # remove leading/trailing quotes
 619         my $val = $item[1];
 620         $val    =~ s/^['"]|['"]$//g;
 621         $return = $val;
 622     }
 623     | /NULL/
 624     { 'NULL' }
 625
 626 !;
 627
 628 # -------------------------------------------------------------------
 629 sub parse {
 630     my ( $translator, $data ) = @_;
 631     my $parser = Parse::RecDescent->new($GRAMMAR);
 632
 633     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 634     local $DEBUG       = $translator->debug;
 635
 636     unless (defined $parser) {
 637         return $translator->error("Error instantiating Parse::RecDescent ".
 638             "instance: Bad grammer");
 639     }
 640
 641     my $result = $parser->startrule($data);
 642     return $translator->error( "Parse failed." ) unless defined $result;
 643     warn "Parse result:".Dumper( $result ) if $DEBUG;
 644
 645     my $schema = $translator->schema;
 646     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 647
 648     my @tables = sort {
 649         $result->{'tables'}{ $a }{'order'}
 650         <=>
 651         $result->{'tables'}{ $b }{'order'}
 652     } keys %{ $result->{'tables'} };
 653
 654     for my $table_name ( @tables ) {
 655         my $tdata =  $result->{tables}{ $table_name };
 656         my $table =  $schema->add_table(
 657             name  => $tdata->{'table_name'},
 658         ) or die $schema->error;
 659
 660         $table->comments( $tdata->{'comments'} );
 661
 662         my @fields = sort {
 663             $tdata->{'fields'}->{$a}->{'order'}
 664             <=>
 665             $tdata->{'fields'}->{$b}->{'order'}
 666         } keys %{ $tdata->{'fields'} };
 667
 668         for my $fname ( @fields ) {
 669             my $fdata = $tdata->{'fields'}{ $fname };
 670             my $field = $table->add_field(
 671                 name              => $fdata->{'name'},
 672                 data_type         => $fdata->{'data_type'},
 673                 size              => $fdata->{'size'},
 674                 default_value     => $fdata->{'default'},
 675                 is_auto_increment => $fdata->{'is_auto_inc'},
 676                 is_nullable       => $fdata->{'null'},
 677                 comments          => $fdata->{'comments'},
 678             ) or die $table->error;
 679
 680             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 681
 682             for my $qual ( qw[ binary unsigned zerofill list ] ) {
 683                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 684                     next if ref $val eq 'ARRAY' && !@$val;
 685                     $field->extra( $qual, $val );
 686                 }
 687             }
 688
 689             if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 690                 my %extra = $field->extra;
 691                 my $longest = 0;
 692                 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 693                     $longest = $len if $len > $longest;
 694                 }
 695                 $field->size( $longest ) if $longest;
 696             }
 697
 698             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 699                 next unless $cdata->{'type'} eq 'foreign_key';
 700                 $cdata->{'fields'} ||= [ $field->name ];
 701                 push @{ $tdata->{'constraints'} }, $cdata;
 702             }
 703         }
 704
 705         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 706             my $index  =  $table->add_index(
 707                 name   => $idata->{'name'},
 708                 type   => uc $idata->{'type'},
 709                 fields => $idata->{'fields'},
 710             ) or die $table->error;
 711         }
 712
 713         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 714             $table->options( \@options ) or die $table->error;
 715         }
 716
 717         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 718             my $constraint       =  $table->add_constraint(
 719                 name             => $cdata->{'name'},
 720                 type             => $cdata->{'type'},
 721                 fields           => $cdata->{'fields'},
 722                 reference_table  => $cdata->{'reference_table'},
 723                 reference_fields => $cdata->{'reference_fields'},
 724                 match_type       => $cdata->{'match_type'} || '',
 725                 on_delete        => $cdata->{'on_delete_do'},
 726                 on_update        => $cdata->{'on_update_do'},
 727             ) or die $table->error;
 728         }
 729     }
 730
 731     return 1;
 732 }
 733
 734 1;
 735
 736 # -------------------------------------------------------------------
 737 # Where man is not nature is barren.
 738 # William Blake
 739 # -------------------------------------------------------------------
 740
 741 =pod
 742
 743 =head1 AUTHOR
 744
 745 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 746 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 747
 748 =head1 SEE ALSO
 749
 750 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 751
 752 =cut