lib/SQL/Translator/Parser/MySQL.pm

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