[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / MySQL.pm

package SQL::Translator::Parser::MySQL;

# -------------------------------------------------------------------
# $Id: MySQL.pm,v 1.22 2003-06-04 22:04:53 kycl4rk Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
#                    darren chamberlain <darren@cpan.org>,
#                    Chris Mungall <cjm@fruitfly.org>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=head1 NAME

SQL::Translator::Parser::MySQL - parser for MySQL

=head1 SYNOPSIS

  use SQL::Translator;
  use SQL::Translator::Parser::MySQL;

  my $translator = SQL::Translator->new;
  $translator->parser("SQL::Translator::Parser::MySQL");

=head1 DESCRIPTION

The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.

Here's the word from the MySQL site
(http://www.mysql.com/doc/en/CREATE_TABLE.html):

  CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
  [table_options] [select_statement]
  
  or
  
  CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
  
  create_definition:
    col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
              [PRIMARY KEY] [reference_definition]
    or    PRIMARY KEY (index_col_name,...)
    or    KEY [index_name] (index_col_name,...)
    or    INDEX [index_name] (index_col_name,...)
    or    UNIQUE [INDEX] [index_name] (index_col_name,...)
    or    FULLTEXT [INDEX] [index_name] (index_col_name,...)
    or    [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
              [reference_definition]
    or    CHECK (expr)
  
  type:
          TINYINT[(length)] [UNSIGNED] [ZEROFILL]
    or    SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
    or    MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
    or    INT[(length)] [UNSIGNED] [ZEROFILL]
    or    INTEGER[(length)] [UNSIGNED] [ZEROFILL]
    or    BIGINT[(length)] [UNSIGNED] [ZEROFILL]
    or    REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
    or    DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
    or    FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
    or    DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
    or    NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
    or    CHAR(length) [BINARY]
    or    VARCHAR(length) [BINARY]
    or    DATE
    or    TIME
    or    TIMESTAMP
    or    DATETIME
    or    TINYBLOB
    or    BLOB
    or    MEDIUMBLOB
    or    LONGBLOB
    or    TINYTEXT
    or    TEXT
    or    MEDIUMTEXT
    or    LONGTEXT
    or    ENUM(value1,value2,value3,...)
    or    SET(value1,value2,value3,...)
  
  index_col_name:
          col_name [(length)]
  
  reference_definition:
          REFERENCES tbl_name [(index_col_name,...)]
                     [MATCH FULL | MATCH PARTIAL]
                     [ON DELETE reference_option]
                     [ON UPDATE reference_option]
  
  reference_option:
          RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
  
  table_options:
          TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
  or      AUTO_INCREMENT = #
  or      AVG_ROW_LENGTH = #
  or      CHECKSUM = {0 | 1}
  or      COMMENT = "string"
  or      MAX_ROWS = #
  or      MIN_ROWS = #
  or      PACK_KEYS = {0 | 1 | DEFAULT}
  or      PASSWORD = "string"
  or      DELAY_KEY_WRITE = {0 | 1}
  or      ROW_FORMAT= { default | dynamic | fixed | compressed }
  or      RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=#  RAID_CHUNKSIZE=#
  or      UNION = (table_name,[table_name...])
  or      INSERT_METHOD= {NO | FIRST | LAST }
  or      DATA DIRECTORY="absolute path to directory"
  or      INDEX DIRECTORY="absolute path to directory"

=cut

use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
$VERSION = sprintf "%d.%02d", q$Revision: 1.22 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 0 unless defined $DEBUG;

use Data::Dumper;
use Parse::RecDescent;
use Exporter;
use base qw(Exporter);

@EXPORT_OK = qw(parse);

# Enable warnings within the Parse::RecDescent module.
$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
$::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
$::RD_HINT   = 1; # Give out hints to help fix problems.

$GRAMMAR = q!

{ 
    our ( %tables, $table_order );
}

#
# The "eofile" rule makes the parser fail if any "statement" rule
# fails.  Otherwise, the first successful match by a "statement" 
# won't cause the failure needed to know that the parse, as a whole,
# failed. -ky
#
startrule : statement(s) eofile { \%tables }

eofile : /^\Z/

statement : comment
    | use
    | drop
    | create
    | <error>

use : /use/i WORD ';'

drop : /drop/i WORD(s) ';'

create : CREATE /database/i WORD ';'

create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
    { 
        my $table_name                       = $item{'table_name'};
        $tables{ $table_name }{'order'}      = ++$table_order;
        $tables{ $table_name }{'table_name'} = $table_name;

        my $i = 1;
        for my $definition ( @{ $item[7] } ) {
            if ( $definition->{'type'} eq 'field' ) {
                my $field_name = $definition->{'name'};
                $tables{ $table_name }{'fields'}{ $field_name } = 
                    { %$definition, order => $i };
                $i++;
        
                if ( $definition->{'is_primary_key'} ) {
                    push @{ $tables{ $table_name }{'indices'} },
                        {
                            type   => 'primary_key',
                            fields => [ $field_name ],
                        }
                    ;
                }
            }
            elsif ( $definition->{'type'} eq 'foreign_key' ) {
                for my $field ( @{ $definition->{'fields'} } ) {
                    push @{ 
                        $tables{$table_name}{'fields'}{$field}{'constraints'}
                    },
                    $definition; 
                }
            }
            else {
                push @{ $tables{ $table_name }{'indices'} },
                    $definition;
            }
        }

        for my $opt ( @{ $item{'table_option(s?)'} } ) {
            if ( my ( $key, $val ) = each %$opt ) {
                $tables{ $table_name }{'table_options'}{ $key } = $val;
            }
        }

        1;
    }

opt_if_not_exists : /if not exists/i

create : /CREATE/i unique(?) /(INDEX|KEY)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
    {
        push @{ $tables{ $item{'table_name'} }{'indices'} },
            {
                name   => $item[4],
                type   => $item[2] ? 'unique' : 'normal',
                fields => $item[8],
            }
        ;
    }

create_definition : index
    | foreign_key 
    | field
    | <error>

comment : /^\s*(?:#|-{2}).*\n/

blank : /\s*/

field : field_name data_type field_qualifier(s?) reference_definition(?)
    { 
        my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
        my $null = defined $item{'not_null'} ? $item{'not_null'} : 1;
        delete $qualifiers{'not_null'};
        if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
            $qualifiers{ $_ } = 1 for @type_quals;
        }

        $return = { 
            type           => 'field',
            name           => $item{'field_name'}, 
            data_type      => $item{'data_type'}{'type'},
            size           => $item{'data_type'}{'size'},
            list           => $item{'data_type'}{'list'},
            null           => $null,
            constraints    => $item{'reference_definition(?)'},
            %qualifiers,
        } 
    }
    | <error>

field_qualifier : not_null
    { 
        $return = { 
             null => $item{'not_null'},
        } 
    }

field_qualifier : default_val
    { 
        $return = { 
             default => $item{'default_val'},
        } 
    }

field_qualifier : auto_inc
    { 
        $return = { 
             is_auto_inc => $item{'auto_inc'},
        } 
    }

field_qualifier : primary_key
    { 
        $return = { 
             is_primary_key => $item{'primary_key'},
        } 
    }

field_qualifier : unsigned
    { 
        $return = { 
             is_unsigned => $item{'unsigned'},
        } 
    }

reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
    {
        $return = {
            type             => 'foreign_key',
            reference_table  => $item[2],
            reference_fields => $item[3][0],
            match_type       => $item[4][0],
            on_delete_do     => $item[5][0],
            on_update_do     => $item[6][0],
        }
    }


match_type : /match full/i { 'match_full' }
    |
    /match partial/i { 'match_partial' }

on_delete_do : /on delete/i reference_option
    { $item[2] }

on_update_do : /on update/i reference_option
    { $item[2] }

reference_option: /restrict/i | 
    /cascade/i   | 
    /set null/i  | 
    /no action/i | 
    /set default/i
    { $item[1] }  

index : primary_key_index
    | unique_index
    | fulltext_index
    | normal_index
    | <error>

table_name   : WORD

field_name   : WORD

index_name   : WORD

data_type    : WORD parens_value_list(s?) type_qualifier(s?)
    { 
        my $type = $item[1];
        my $size; # field size, applicable only to non-set fields
        my $list; # set list, applicable only to sets (duh)

        if ( uc($type) =~ /^(SET|ENUM)$/ ) {
            $size = undef;
            $list = $item[2][0];
        }
        else {
            $size = $item[2][0];
            $list = [];
        }

        unless ( @{ $size || [] } ) {
            if ( lc $type eq 'tinyint' ) {
                $size = [4];
            }
            elsif ( lc $type eq 'smallint' ) {
                $size = [6];
            }
            elsif ( lc $type eq 'mediumint' ) {
                $size = [9];
            }
            elsif ( $type =~ /^int(eger)?$/ ) {
                $size = [11];
            }
            elsif ( lc $type eq 'bigint' ) {
                $size = [20];
            }
            elsif ( lc $type =~ /(float|double|decimal|numeric|real)/ ) {
                $size = [8,2];
            }
        }

        $return        = { 
            type       => $type,
            size       => $size,
            list       => $list,
            qualifiers => $item[3],
        } 
    }

parens_field_list : '(' field_name(s /,/) ')'
    { $item[2] }

parens_value_list : '(' VALUE(s /,/) ')'
    { $item[2] }

type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
    { lc $item[1] }

field_type   : WORD

create_index : /create/i /index/i

not_null     : /not/i /null/i { $return = 0 }

unsigned     : /unsigned/i { $return = 0 }

default_val  : /default/i /(?:')?[\w\d:.-]*(?:')?/ 
    { 
        $item[2] =~ s/'//g; 
        $return  =  $item[2];
    }

auto_inc : /auto_increment/i { 1 }

primary_key : /primary/i /key/i { 1 }

foreign_key : opt_constraint(?) /foreign key/i WORD(?) parens_field_list reference_definition
    {
        $return              =  {
            type             => 'foreign_key',
            name             => $item[3][0],
            fields           => $item[4],
            %{ $item{'reference_definition'} },
        }
    }

opt_constraint : /constraint/i WORD

primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
    { 
        $return    = { 
            name   => $item{'index_name(?)'}[0],
            type   => 'primary_key',
            fields => $item[4],
        };
    }

normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
    { 
        $return    = { 
            name   => $item{'index_name(?)'}[0],
            type   => 'normal',
            fields => $item[4],
        } 
    }

unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
    { 
        $return    = { 
            name   => $item{'index_name(?)'}[0],
            type   => 'unique',
            fields => $item[5],
        } 
    }

fulltext_index : fulltext key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
    { 
        $return    = { 
            name   => $item{'index_name(?)'}[0],
            type   => 'fulltext',
            fields => $item[5],
        } 
    }

name_with_opt_paren : NAME parens_value_list(s?)
    { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }

fulltext : /fulltext/i { 1 }

unique : /unique/i { 1 }

key : /key/i | /index/i

table_option : /[^\s;]*/ 
    { 
        $return = { split /=/, $item[1] }
    }

CREATE : /create/i

TEMPORARY : /temporary/i

TABLE : /table/i

WORD : /\w+/

DIGITS : /\d+/

COMMA : ','

NAME    : "`" /\w+/ "`"
    { $item[2] }
    | /\w+/
    { $item[1] }

VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
    { $item[1] }
    | /'.*?'/   # XXX doesn't handle embedded quotes
    { $item[1] }
    | /NULL/
    { 'NULL' }

!;

# -------------------------------------------------------------------
sub parse {
    my ( $translator, $data ) = @_;
    my $parser = Parse::RecDescent->new($GRAMMAR);

    local $::RD_TRACE  = $translator->trace ? 1 : undef;
    local $DEBUG       = $translator->debug;

    unless (defined $parser) {
        return $translator->error("Error instantiating Parse::RecDescent ".
            "instance: Bad grammer");
    }

    my $result = $parser->startrule($data);
    return $translator->error( "Parse failed." ) unless defined $result;
    warn Dumper( $result ) if $DEBUG;

    my $schema = $translator->schema;
    for my $table_name ( keys %{ $result } ) {
        my $tdata =  $result->{ $table_name };
        my $table =  $schema->add_table( 
            name  => $tdata->{'table_name'},
        ) or die $schema->error;

        my @fields = sort { 
            $tdata->{'fields'}->{$a}->{'order'} 
            <=>
            $tdata->{'fields'}->{$b}->{'order'}
        } keys %{ $tdata->{'fields'} };

        for my $fname ( @fields ) {
            my $fdata = $tdata->{'fields'}{ $fname };
            my $field = $table->add_field(
                name              => $fdata->{'name'},
                data_type         => $fdata->{'data_type'},
                size              => $fdata->{'size'},
                default_value     => $fdata->{'default'},
                is_auto_increment => $fdata->{'is_auto_inc'},
                is_nullable       => $fdata->{'null'},
            ) or die $table->error;
        }
    }

    return $result;
}

1;

# ----------------------------------------------------
# Where man is not nature is barren.
# William Blake
# ----------------------------------------------------

=pod

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.

=head1 SEE ALSO

perl(1), Parse::RecDescent, SQL::Translator::Schema.

=cut
Commit	Line	Data
16dc9970	1	package SQL::Translator::Parser::MySQL;
16dc9970	2
49e1eb70	3	# -------------------------------------------------------------------
dcb4fa06	4	# $Id: MySQL.pm,v 1.22 2003-06-04 22:04:53 kycl4rk Exp $
49e1eb70	5	# -------------------------------------------------------------------
abfa405a	6	# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
	7	# darren chamberlain <darren@cpan.org>,
	8	# Chris Mungall <cjm@fruitfly.org>
077ebf34	9	#
	10	# This program is free software; you can redistribute it and/or
	11	# modify it under the terms of the GNU General Public License as
	12	# published by the Free Software Foundation; version 2.
	13	#
	14	# This program is distributed in the hope that it will be useful, but
	15	# WITHOUT ANY WARRANTY; without even the implied warranty of
	16	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	17	# General Public License for more details.
	18	#
	19	# You should have received a copy of the GNU General Public License
	20	# along with this program; if not, write to the Free Software
	21	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
	22	# 02111-1307 USA
	23	# -------------------------------------------------------------------
16dc9970	24
d529894e	25	=head1 NAME
	26
	27	SQL::Translator::Parser::MySQL - parser for MySQL
	28
	29	=head1 SYNOPSIS
	30
	31	use SQL::Translator;
	32	use SQL::Translator::Parser::MySQL;
	33
	34	my $translator = SQL::Translator->new;
	35	$translator->parser("SQL::Translator::Parser::MySQL");
	36
	37	=head1 DESCRIPTION
	38
	39	The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
	40
629b76f9	41	Here's the word from the MySQL site
	42	(http://www.mysql.com/doc/en/CREATE_TABLE.html):
	43
	44	CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
	45	[table_options] [select_statement]
	46
	47	or
	48
	49	CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
	50
	51	create_definition:
	52	col_name type [NOT NULL \| NULL] [DEFAULT default_value] [AUTO_INCREMENT]
	53	[PRIMARY KEY] [reference_definition]
	54	or PRIMARY KEY (index_col_name,...)
	55	or KEY [index_name] (index_col_name,...)
	56	or INDEX [index_name] (index_col_name,...)
	57	or UNIQUE [INDEX] [index_name] (index_col_name,...)
	58	or FULLTEXT [INDEX] [index_name] (index_col_name,...)
	59	or [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
	60	[reference_definition]
	61	or CHECK (expr)
	62
	63	type:
	64	TINYINT[(length)] [UNSIGNED] [ZEROFILL]
	65	or SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
	66	or MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
	67	or INT[(length)] [UNSIGNED] [ZEROFILL]
	68	or INTEGER[(length)] [UNSIGNED] [ZEROFILL]
	69	or BIGINT[(length)] [UNSIGNED] [ZEROFILL]
	70	or REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
	71	or DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
	72	or FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
	73	or DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
	74	or NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
	75	or CHAR(length) [BINARY]
	76	or VARCHAR(length) [BINARY]
	77	or DATE
	78	or TIME
	79	or TIMESTAMP
	80	or DATETIME
	81	or TINYBLOB
	82	or BLOB
	83	or MEDIUMBLOB
	84	or LONGBLOB
	85	or TINYTEXT
	86	or TEXT
	87	or MEDIUMTEXT
	88	or LONGTEXT
	89	or ENUM(value1,value2,value3,...)
	90	or SET(value1,value2,value3,...)
	91
	92	index_col_name:
	93	col_name [(length)]
	94
	95	reference_definition:
	96	REFERENCES tbl_name [(index_col_name,...)]
	97	[MATCH FULL \| MATCH PARTIAL]
	98	[ON DELETE reference_option]
	99	[ON UPDATE reference_option]
	100
	101	reference_option:
	102	RESTRICT \| CASCADE \| SET NULL \| NO ACTION \| SET DEFAULT
	103
	104	table_options:
105	TYPE = {BDB \| HEAP \| ISAM \| InnoDB \| MERGE \| MRG_MYISAM \| MYISAM }
106	or AUTO_INCREMENT = #
107	or AVG_ROW_LENGTH = #
108	or CHECKSUM = {0 \| 1}
109	or COMMENT = "string"
110	or MAX_ROWS = #
111	or MIN_ROWS = #
112	or PACK_KEYS = {0 \| 1 \| DEFAULT}
113	or PASSWORD = "string"
114	or DELAY_KEY_WRITE = {0 \| 1}
115	or ROW_FORMAT= { default \| dynamic \| fixed \| compressed }
116	or RAID_TYPE= {1 \| STRIPED \| RAID0 } RAID_CHUNKS=# RAID_CHUNKSIZE=#
117	or UNION = (table_name,[table_name...])
118	or INSERT_METHOD= {NO \| FIRST \| LAST }
119	or DATA DIRECTORY="absolute path to directory"
120	or INDEX DIRECTORY="absolute path to directory"
121
d529894e	122	=cut
d529894e	123
16dc9970	124	use strict;
d529894e	125	use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
dcb4fa06	126	$VERSION = sprintf "%d.%02d", q$Revision: 1.22 $ =~ /(\d+)\.(\d+)/;
8d0f3086	127	$DEBUG = 0 unless defined $DEBUG;
077ebf34	128
d529894e	129	use Data::Dumper;
077ebf34	130	use Parse::RecDescent;
	131	use Exporter;
	132	use base qw(Exporter);
	133
	134	@EXPORT_OK = qw(parse);
	135
d529894e	136	# Enable warnings within the Parse::RecDescent module.
	137	$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
	138	$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.
	139	$::RD_HINT = 1; # Give out hints to help fix problems.
	140
d529894e	141	$GRAMMAR = q!
d529894e	142
8ccdeb42	143	{
	144	our ( %tables, $table_order );
	145	}
d529894e	146
629b76f9	147	#
	148	# The "eofile" rule makes the parser fail if any "statement" rule
	149	# fails. Otherwise, the first successful match by a "statement"
	150	# won't cause the failure needed to know that the parse, as a whole,
	151	# failed. -ky
	152	#
	153	startrule : statement(s) eofile { \%tables }
	154
	155	eofile : /^\Z/
d529894e	156
d529894e	157	statement : comment
dcb4fa06	158	\| use
61745327	159	\| drop
d529894e	160	\| create
	161	\| <error>
	162
dcb4fa06	163	use : /use/i WORD ';'
dcb4fa06	164
61745327	165	drop : /drop/i WORD(s) ';'
61745327	166
dcb4fa06	167	create : CREATE /database/i WORD ';'
dcb4fa06	168
40c1ade1	169	create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
d529894e	170	{
	171	my $table_name = $item{'table_name'};
	172	$tables{ $table_name }{'order'} = ++$table_order;
	173	$tables{ $table_name }{'table_name'} = $table_name;
	174
61745327	175	my $i = 1;
40c1ade1	176	for my $definition ( @{ $item[7] } ) {
d529894e	177	if ( $definition->{'type'} eq 'field' ) {
	178	my $field_name = $definition->{'name'};
	179	$tables{ $table_name }{'fields'}{ $field_name } =
	180	{ %$definition, order => $i };
	181	$i++;
	182
	183	if ( $definition->{'is_primary_key'} ) {
	184	push @{ $tables{ $table_name }{'indices'} },
	185	{
	186	type => 'primary_key',
	187	fields => [ $field_name ],
16dc9970	188	}
d529894e	189	;
d529894e	190	}
dd2ef5ae	191	}
40c1ade1	192	elsif ( $definition->{'type'} eq 'foreign_key' ) {
	193	for my $field ( @{ $definition->{'fields'} } ) {
	194	push @{
	195	$tables{$table_name}{'fields'}{$field}{'constraints'}
	196	},
	197	$definition;
	198	}
	199	}
d529894e	200	else {
	201	push @{ $tables{ $table_name }{'indices'} },
	202	$definition;
dd2ef5ae	203	}
d529894e	204	}
dd2ef5ae	205
58a88238	206	for my $opt ( @{ $item{'table_option(s?)'} } ) {
d529894e	207	if ( my ( $key, $val ) = each %$opt ) {
d529894e	208	$tables{ $table_name }{'table_options'}{ $key } = $val;
dd2ef5ae	209	}
d529894e	210	}
58a88238	211
58a88238	212	1;
d529894e	213	}
dd2ef5ae	214
40c1ade1	215	opt_if_not_exists : /if not exists/i
40c1ade1	216
d529894e	217	create : /CREATE/i unique(?) /(INDEX\|KEY)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
	218	{
	219	push @{ $tables{ $item{'table_name'} }{'indices'} },
	220	{
	221	name => $item[4],
	222	type => $item[2] ? 'unique' : 'normal',
	223	fields => $item[8],
dd2ef5ae	224	}
d529894e	225	;
d529894e	226	}
dd2ef5ae	227
d529894e	228	create_definition : index
40c1ade1	229	\| foreign_key
d529894e	230	\| field
	231	\| <error>
	232
	233	comment : /^\s(?:#\|-{2}).\n/
	234
	235	blank : /\s*/
	236
658637cd	237	field : field_name data_type field_qualifier(s?) reference_definition(?)
d529894e	238	{
58a88238	239	my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} \|\| [] };
d529894e	240	my $null = defined $item{'not_null'} ? $item{'not_null'} : 1;
	241	delete $qualifiers{'not_null'};
	242	if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} \|\| [] } ) {
	243	$qualifiers{ $_ } = 1 for @type_quals;
	244	}
	245
	246	$return = {
	247	type => 'field',
	248	name => $item{'field_name'},
	249	data_type => $item{'data_type'}{'type'},
	250	size => $item{'data_type'}{'size'},
	251	list => $item{'data_type'}{'list'},
	252	null => $null,
58a88238	253	constraints => $item{'reference_definition(?)'},
d529894e	254	%qualifiers,
	255	}
	256	}
	257	\| <error>
dd2ef5ae	258
d529894e	259	field_qualifier : not_null
	260	{
	261	$return = {
	262	null => $item{'not_null'},
	263	}
	264	}
16dc9970	265
d529894e	266	field_qualifier : default_val
	267	{
	268	$return = {
	269	default => $item{'default_val'},
	270	}
	271	}
16dc9970	272
d529894e	273	field_qualifier : auto_inc
	274	{
	275	$return = {
	276	is_auto_inc => $item{'auto_inc'},
	277	}
	278	}
16dc9970	279
d529894e	280	field_qualifier : primary_key
	281	{
	282	$return = {
	283	is_primary_key => $item{'primary_key'},
	284	}
	285	}
16dc9970	286
d529894e	287	field_qualifier : unsigned
	288	{
	289	$return = {
	290	is_unsigned => $item{'unsigned'},
	291	}
	292	}
16dc9970	293
658637cd	294	reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
658637cd	295	{
40c1ade1	296	$return = {
658637cd	297	type => 'foreign_key',
	298	reference_table => $item[2],
	299	reference_fields => $item[3][0],
	300	match_type => $item[4][0],
	301	on_delete_do => $item[5][0],
	302	on_update_do => $item[6][0],
	303	}
	304	}
	305
40c1ade1	306
658637cd	307	match_type : /match full/i { 'match_full' }
	308	\|
	309	/match partial/i { 'match_partial' }
	310
	311	on_delete_do : /on delete/i reference_option
	312	{ $item[2] }
	313
	314	on_update_do : /on update/i reference_option
	315	{ $item[2] }
	316
	317	reference_option: /restrict/i \|
	318	/cascade/i \|
	319	/set null/i \|
	320	/no action/i \|
	321	/set default/i
	322	{ $item[1] }
	323
d529894e	324	index : primary_key_index
d529894e	325	\| unique_index
371f5f88	326	\| fulltext_index
d529894e	327	\| normal_index
58a88238	328	\| <error>
d529894e	329
	330	table_name : WORD
	331
	332	field_name : WORD
	333
	334	index_name : WORD
	335
	336	data_type : WORD parens_value_list(s?) type_qualifier(s?)
	337	{
	338	my $type = $item[1];
	339	my $size; # field size, applicable only to non-set fields
	340	my $list; # set list, applicable only to sets (duh)
	341
44fcd0b5	342	if ( uc($type) =~ /^(SET\|ENUM)$/ ) {
d529894e	343	$size = undef;
	344	$list = $item[2][0];
	345	}
	346	else {
	347	$size = $item[2][0];
	348	$list = [];
	349	}
	350
6333c482	351	unless ( @{ $size \|\| [] } ) {
	352	if ( lc $type eq 'tinyint' ) {
	353	$size = [4];
	354	}
	355	elsif ( lc $type eq 'smallint' ) {
	356	$size = [6];
	357	}
	358	elsif ( lc $type eq 'mediumint' ) {
	359	$size = [9];
	360	}
c736c39c	361	elsif ( $type =~ /^int(eger)?$/ ) {
6333c482	362	$size = [11];
	363	}
	364	elsif ( lc $type eq 'bigint' ) {
	365	$size = [20];
	366	}
c736c39c	367	elsif ( lc $type =~ /(float\|double\|decimal\|numeric\|real)/ ) {
6333c482	368	$size = [8,2];
	369	}
	370	}
	371
d529894e	372	$return = {
	373	type => $type,
	374	size => $size,
	375	list => $list,
	376	qualifiers => $item[3],
	377	}
	378	}
16dc9970	379
658637cd	380	parens_field_list : '(' field_name(s /,/) ')'
	381	{ $item[2] }
	382
d529894e	383	parens_value_list : '(' VALUE(s /,/) ')'
d529894e	384	{ $item[2] }
16dc9970	385
d529894e	386	type_qualifier : /(BINARY\|UNSIGNED\|ZEROFILL)/i
d529894e	387	{ lc $item[1] }
16dc9970	388
d529894e	389	field_type : WORD
16dc9970	390
d529894e	391	create_index : /create/i /index/i
dd2ef5ae	392
d529894e	393	not_null : /not/i /null/i { $return = 0 }
16dc9970	394
d529894e	395	unsigned : /unsigned/i { $return = 0 }
16dc9970	396
be019aae	397	default_val : /default/i /(?:')?[\w\d:.-]*(?:')?/
d529894e	398	{
	399	$item[2] =~ s/'//g;
	400	$return = $item[2];
	401	}
16dc9970	402
d529894e	403	auto_inc : /auto_increment/i { 1 }
16dc9970	404
d529894e	405	primary_key : /primary/i /key/i { 1 }
16dc9970	406
40c1ade1	407	foreign_key : opt_constraint(?) /foreign key/i WORD(?) parens_field_list reference_definition
	408	{
	409	$return = {
	410	type => 'foreign_key',
	411	name => $item[3][0],
	412	fields => $item[4],
	413	%{ $item{'reference_definition'} },
	414	}
	415	}
	416
	417	opt_constraint : /constraint/i WORD
	418
d529894e	419	primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
	420	{
	421	$return = {
58a88238	422	name => $item{'index_name(?)'}[0],
d529894e	423	type => 'primary_key',
d529894e	424	fields => $item[4],
58a88238	425	};
d529894e	426	}
16dc9970	427
d529894e	428	normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
	429	{
	430	$return = {
58a88238	431	name => $item{'index_name(?)'}[0],
d529894e	432	type => 'normal',
	433	fields => $item[4],
	434	}
	435	}
16dc9970	436
d529894e	437	unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
	438	{
	439	$return = {
58a88238	440	name => $item{'index_name(?)'}[0],
d529894e	441	type => 'unique',
	442	fields => $item[5],
	443	}
	444	}
16dc9970	445
371f5f88	446	fulltext_index : fulltext key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
	447	{
	448	$return = {
58a88238	449	name => $item{'index_name(?)'}[0],
371f5f88	450	type => 'fulltext',
	451	fields => $item[5],
	452	}
	453	}
	454
d529894e	455	name_with_opt_paren : NAME parens_value_list(s?)
d529894e	456	{ $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
16dc9970	457
371f5f88	458	fulltext : /fulltext/i { 1 }
371f5f88	459
d529894e	460	unique : /unique/i { 1 }
16dc9970	461
d529894e	462	key : /key/i \| /index/i
16dc9970	463
44fcd0b5	464	table_option : /[^\s;]*/
d529894e	465	{
	466	$return = { split /=/, $item[1] }
	467	}
16dc9970	468
40c1ade1	469	CREATE : /create/i
	470
	471	TEMPORARY : /temporary/i
	472
	473	TABLE : /table/i
	474
d529894e	475	WORD : /\w+/
16dc9970	476
d529894e	477	DIGITS : /\d+/
16dc9970	478
d529894e	479	COMMA : ','
16dc9970	480
d529894e	481	NAME : "`" /\w+/ "`"
	482	{ $item[2] }
	483	\| /\w+/
	484	{ $item[1] }
16dc9970	485
d529894e	486	VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
	487	{ $item[1] }
	488	\| /'.*?'/ # XXX doesn't handle embedded quotes
	489	{ $item[1] }
	490	\| /NULL/
	491	{ 'NULL' }
16dc9970	492
d529894e	493	!;
16dc9970	494
d529894e	495	# -------------------------------------------------------------------
d529894e	496	sub parse {
70944bc5	497	my ( $translator, $data ) = @_;
40c1ade1	498	my $parser = Parse::RecDescent->new($GRAMMAR);
077ebf34	499
e099bee9	500	local $::RD_TRACE = $translator->trace ? 1 : undef;
e099bee9	501	local $DEBUG = $translator->debug;
d529894e	502
	503	unless (defined $parser) {
	504	return $translator->error("Error instantiating Parse::RecDescent ".
	505	"instance: Bad grammer");
	506	}
	507
	508	my $result = $parser->startrule($data);
40c1ade1	509	return $translator->error( "Parse failed." ) unless defined $result;
8ccdeb42	510	warn Dumper( $result ) if $DEBUG;
8ccdeb42	511
70944bc5	512	my $schema = $translator->schema;
8ccdeb42	513	for my $table_name ( keys %{ $result } ) {
	514	my $tdata = $result->{ $table_name };
	515	my $table = $schema->add_table(
	516	name => $tdata->{'table_name'},
40c1ade1	517	) or die $schema->error;
8ccdeb42	518
	519	my @fields = sort {
	520	$tdata->{'fields'}->{$a}->{'order'}
	521	<=>
	522	$tdata->{'fields'}->{$b}->{'order'}
	523	} keys %{ $tdata->{'fields'} };
	524
	525	for my $fname ( @fields ) {
	526	my $fdata = $tdata->{'fields'}{ $fname };
	527	my $field = $table->add_field(
	528	name => $fdata->{'name'},
	529	data_type => $fdata->{'data_type'},
	530	size => $fdata->{'size'},
	531	default_value => $fdata->{'default'},
	532	is_auto_increment => $fdata->{'is_auto_inc'},
	533	is_nullable => $fdata->{'null'},
40c1ade1	534	) or die $table->error;
8ccdeb42	535	}
	536	}
	537
d529894e	538	return $result;
	539	}
	540
	541	1;
	542
8ccdeb42	543	# ----------------------------------------------------
d529894e	544	# Where man is not nature is barren.
d529894e	545	# William Blake
8ccdeb42	546	# ----------------------------------------------------
16dc9970	547
d529894e	548	=pod
16dc9970	549
	550	=head1 AUTHOR
	551
d529894e	552	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
8ccdeb42	553	Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
16dc9970	554
	555	=head1 SEE ALSO
	556
8ccdeb42	557	perl(1), Parse::RecDescent, SQL::Translator::Schema.
16dc9970	558
16dc9970	559	=cut