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

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

# -------------------------------------------------------------------
# $Id: MySQL.pm,v 1.20 2003-06-03 22:38:18 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.20 $ =~ /(\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
    | drop
    | create
    | <error>

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

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 ( lc $type eq 'int' ) {
                $size = [11];
            }
            elsif ( lc $type eq 'bigint' ) {
                $size = [20];
            }
            elsif ( lc $type eq 'float' ) {
                $size = [8,2];
            }
            elsif ( lc $type eq 'double' ) {
                $size = [8,2];
            }
            elsif ( lc $type eq 'decimal' ) {
                $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	# -------------------------------------------------------------------
6333c482	4	# $Id: MySQL.pm,v 1.20 2003-06-03 22:38:18 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 ];
6333c482	126	$VERSION = sprintf "%d.%02d", q$Revision: 1.20 $ =~ /(\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
61745327	158	\| drop
d529894e	159	\| create
	160	\| <error>
	161
61745327	162	drop : /drop/i WORD(s) ';'
61745327	163
40c1ade1	164	create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
d529894e	165	{
	166	my $table_name = $item{'table_name'};
	167	$tables{ $table_name }{'order'} = ++$table_order;
	168	$tables{ $table_name }{'table_name'} = $table_name;
	169
61745327	170	my $i = 1;
40c1ade1	171	for my $definition ( @{ $item[7] } ) {
d529894e	172	if ( $definition->{'type'} eq 'field' ) {
	173	my $field_name = $definition->{'name'};
	174	$tables{ $table_name }{'fields'}{ $field_name } =
	175	{ %$definition, order => $i };
	176	$i++;
	177
	178	if ( $definition->{'is_primary_key'} ) {
	179	push @{ $tables{ $table_name }{'indices'} },
	180	{
	181	type => 'primary_key',
	182	fields => [ $field_name ],
16dc9970	183	}
d529894e	184	;
d529894e	185	}
dd2ef5ae	186	}
40c1ade1	187	elsif ( $definition->{'type'} eq 'foreign_key' ) {
	188	for my $field ( @{ $definition->{'fields'} } ) {
	189	push @{
	190	$tables{$table_name}{'fields'}{$field}{'constraints'}
	191	},
	192	$definition;
	193	}
	194	}
d529894e	195	else {
	196	push @{ $tables{ $table_name }{'indices'} },
	197	$definition;
dd2ef5ae	198	}
d529894e	199	}
dd2ef5ae	200
58a88238	201	for my $opt ( @{ $item{'table_option(s?)'} } ) {
d529894e	202	if ( my ( $key, $val ) = each %$opt ) {
d529894e	203	$tables{ $table_name }{'table_options'}{ $key } = $val;
dd2ef5ae	204	}
d529894e	205	}
58a88238	206
58a88238	207	1;
d529894e	208	}
dd2ef5ae	209
40c1ade1	210	opt_if_not_exists : /if not exists/i
40c1ade1	211
d529894e	212	create : /CREATE/i unique(?) /(INDEX\|KEY)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
	213	{
	214	push @{ $tables{ $item{'table_name'} }{'indices'} },
	215	{
	216	name => $item[4],
	217	type => $item[2] ? 'unique' : 'normal',
	218	fields => $item[8],
dd2ef5ae	219	}
d529894e	220	;
d529894e	221	}
dd2ef5ae	222
d529894e	223	create_definition : index
40c1ade1	224	\| foreign_key
d529894e	225	\| field
	226	\| <error>
	227
	228	comment : /^\s(?:#\|-{2}).\n/
	229
	230	blank : /\s*/
	231
658637cd	232	field : field_name data_type field_qualifier(s?) reference_definition(?)
d529894e	233	{
58a88238	234	my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} \|\| [] };
d529894e	235	my $null = defined $item{'not_null'} ? $item{'not_null'} : 1;
	236	delete $qualifiers{'not_null'};
	237	if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} \|\| [] } ) {
	238	$qualifiers{ $_ } = 1 for @type_quals;
	239	}
	240
	241	$return = {
	242	type => 'field',
	243	name => $item{'field_name'},
	244	data_type => $item{'data_type'}{'type'},
	245	size => $item{'data_type'}{'size'},
	246	list => $item{'data_type'}{'list'},
	247	null => $null,
58a88238	248	constraints => $item{'reference_definition(?)'},
d529894e	249	%qualifiers,
	250	}
	251	}
	252	\| <error>
dd2ef5ae	253
d529894e	254	field_qualifier : not_null
	255	{
	256	$return = {
	257	null => $item{'not_null'},
	258	}
	259	}
16dc9970	260
d529894e	261	field_qualifier : default_val
	262	{
	263	$return = {
	264	default => $item{'default_val'},
	265	}
	266	}
16dc9970	267
d529894e	268	field_qualifier : auto_inc
	269	{
	270	$return = {
	271	is_auto_inc => $item{'auto_inc'},
	272	}
	273	}
16dc9970	274
d529894e	275	field_qualifier : primary_key
	276	{
	277	$return = {
	278	is_primary_key => $item{'primary_key'},
	279	}
	280	}
16dc9970	281
d529894e	282	field_qualifier : unsigned
	283	{
	284	$return = {
	285	is_unsigned => $item{'unsigned'},
	286	}
	287	}
16dc9970	288
658637cd	289	reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
658637cd	290	{
40c1ade1	291	$return = {
658637cd	292	type => 'foreign_key',
	293	reference_table => $item[2],
	294	reference_fields => $item[3][0],
	295	match_type => $item[4][0],
	296	on_delete_do => $item[5][0],
	297	on_update_do => $item[6][0],
	298	}
	299	}
	300
40c1ade1	301
658637cd	302	match_type : /match full/i { 'match_full' }
	303	\|
	304	/match partial/i { 'match_partial' }
	305
	306	on_delete_do : /on delete/i reference_option
	307	{ $item[2] }
	308
	309	on_update_do : /on update/i reference_option
	310	{ $item[2] }
	311
	312	reference_option: /restrict/i \|
	313	/cascade/i \|
	314	/set null/i \|
	315	/no action/i \|
	316	/set default/i
	317	{ $item[1] }
	318
d529894e	319	index : primary_key_index
d529894e	320	\| unique_index
371f5f88	321	\| fulltext_index
d529894e	322	\| normal_index
58a88238	323	\| <error>
d529894e	324
	325	table_name : WORD
	326
	327	field_name : WORD
	328
	329	index_name : WORD
	330
	331	data_type : WORD parens_value_list(s?) type_qualifier(s?)
	332	{
	333	my $type = $item[1];
	334	my $size; # field size, applicable only to non-set fields
	335	my $list; # set list, applicable only to sets (duh)
	336
44fcd0b5	337	if ( uc($type) =~ /^(SET\|ENUM)$/ ) {
d529894e	338	$size = undef;
	339	$list = $item[2][0];
	340	}
	341	else {
	342	$size = $item[2][0];
	343	$list = [];
	344	}
	345
6333c482	346	unless ( @{ $size \|\| [] } ) {
	347	if ( lc $type eq 'tinyint' ) {
	348	$size = [4];
	349	}
	350	elsif ( lc $type eq 'smallint' ) {
	351	$size = [6];
	352	}
	353	elsif ( lc $type eq 'mediumint' ) {
	354	$size = [9];
	355	}
	356	elsif ( lc $type eq 'int' ) {
	357	$size = [11];
	358	}
	359	elsif ( lc $type eq 'bigint' ) {
	360	$size = [20];
	361	}
	362	elsif ( lc $type eq 'float' ) {
	363	$size = [8,2];
	364	}
	365	elsif ( lc $type eq 'double' ) {
	366	$size = [8,2];
	367	}
	368	elsif ( lc $type eq 'decimal' ) {
	369	$size = [8,2];
	370	}
	371	}
	372
d529894e	373	$return = {
	374	type => $type,
	375	size => $size,
	376	list => $list,
	377	qualifiers => $item[3],
	378	}
	379	}
16dc9970	380
658637cd	381	parens_field_list : '(' field_name(s /,/) ')'
	382	{ $item[2] }
	383
d529894e	384	parens_value_list : '(' VALUE(s /,/) ')'
d529894e	385	{ $item[2] }
16dc9970	386
d529894e	387	type_qualifier : /(BINARY\|UNSIGNED\|ZEROFILL)/i
d529894e	388	{ lc $item[1] }
16dc9970	389
d529894e	390	field_type : WORD
16dc9970	391
d529894e	392	create_index : /create/i /index/i
dd2ef5ae	393
d529894e	394	not_null : /not/i /null/i { $return = 0 }
16dc9970	395
d529894e	396	unsigned : /unsigned/i { $return = 0 }
16dc9970	397
be019aae	398	default_val : /default/i /(?:')?[\w\d:.-]*(?:')?/
d529894e	399	{
	400	$item[2] =~ s/'//g;
	401	$return = $item[2];
	402	}
16dc9970	403
d529894e	404	auto_inc : /auto_increment/i { 1 }
16dc9970	405
d529894e	406	primary_key : /primary/i /key/i { 1 }
16dc9970	407
40c1ade1	408	foreign_key : opt_constraint(?) /foreign key/i WORD(?) parens_field_list reference_definition
	409	{
	410	$return = {
	411	type => 'foreign_key',
	412	name => $item[3][0],
	413	fields => $item[4],
	414	%{ $item{'reference_definition'} },
	415	}
	416	}
	417
	418	opt_constraint : /constraint/i WORD
	419
d529894e	420	primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
	421	{
	422	$return = {
58a88238	423	name => $item{'index_name(?)'}[0],
d529894e	424	type => 'primary_key',
d529894e	425	fields => $item[4],
58a88238	426	};
d529894e	427	}
16dc9970	428
d529894e	429	normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
	430	{
	431	$return = {
58a88238	432	name => $item{'index_name(?)'}[0],
d529894e	433	type => 'normal',
	434	fields => $item[4],
	435	}
	436	}
16dc9970	437
d529894e	438	unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
	439	{
	440	$return = {
58a88238	441	name => $item{'index_name(?)'}[0],
d529894e	442	type => 'unique',
	443	fields => $item[5],
	444	}
	445	}
16dc9970	446
371f5f88	447	fulltext_index : fulltext key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
	448	{
	449	$return = {
58a88238	450	name => $item{'index_name(?)'}[0],
371f5f88	451	type => 'fulltext',
	452	fields => $item[5],
	453	}
	454	}
	455
d529894e	456	name_with_opt_paren : NAME parens_value_list(s?)
d529894e	457	{ $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
16dc9970	458
371f5f88	459	fulltext : /fulltext/i { 1 }
371f5f88	460
d529894e	461	unique : /unique/i { 1 }
16dc9970	462
d529894e	463	key : /key/i \| /index/i
16dc9970	464
44fcd0b5	465	table_option : /[^\s;]*/
d529894e	466	{
	467	$return = { split /=/, $item[1] }
	468	}
16dc9970	469
40c1ade1	470	CREATE : /create/i
	471
	472	TEMPORARY : /temporary/i
	473
	474	TABLE : /table/i
	475
d529894e	476	WORD : /\w+/
16dc9970	477
d529894e	478	DIGITS : /\d+/
16dc9970	479
d529894e	480	COMMA : ','
16dc9970	481
d529894e	482	NAME : "`" /\w+/ "`"
	483	{ $item[2] }
	484	\| /\w+/
	485	{ $item[1] }
16dc9970	486
d529894e	487	VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
	488	{ $item[1] }
	489	\| /'.*?'/ # XXX doesn't handle embedded quotes
	490	{ $item[1] }
	491	\| /NULL/
	492	{ 'NULL' }
16dc9970	493
d529894e	494	!;
16dc9970	495
d529894e	496	# -------------------------------------------------------------------
d529894e	497	sub parse {
70944bc5	498	my ( $translator, $data ) = @_;
40c1ade1	499	my $parser = Parse::RecDescent->new($GRAMMAR);
077ebf34	500
e099bee9	501	local $::RD_TRACE = $translator->trace ? 1 : undef;
e099bee9	502	local $DEBUG = $translator->debug;
d529894e	503
	504	unless (defined $parser) {
	505	return $translator->error("Error instantiating Parse::RecDescent ".
	506	"instance: Bad grammer");
	507	}
	508
	509	my $result = $parser->startrule($data);
40c1ade1	510	return $translator->error( "Parse failed." ) unless defined $result;
8ccdeb42	511	warn Dumper( $result ) if $DEBUG;
8ccdeb42	512
70944bc5	513	my $schema = $translator->schema;
8ccdeb42	514	for my $table_name ( keys %{ $result } ) {
	515	my $tdata = $result->{ $table_name };
	516	my $table = $schema->add_table(
	517	name => $tdata->{'table_name'},
40c1ade1	518	) or die $schema->error;
8ccdeb42	519
	520	my @fields = sort {
	521	$tdata->{'fields'}->{$a}->{'order'}
	522	<=>
	523	$tdata->{'fields'}->{$b}->{'order'}
	524	} keys %{ $tdata->{'fields'} };
	525
	526	for my $fname ( @fields ) {
	527	my $fdata = $tdata->{'fields'}{ $fname };
	528	my $field = $table->add_field(
	529	name => $fdata->{'name'},
	530	data_type => $fdata->{'data_type'},
	531	size => $fdata->{'size'},
	532	default_value => $fdata->{'default'},
	533	is_auto_increment => $fdata->{'is_auto_inc'},
	534	is_nullable => $fdata->{'null'},
40c1ade1	535	) or die $table->error;
8ccdeb42	536	}
	537	}
	538
d529894e	539	return $result;
	540	}
	541
	542	1;
	543
8ccdeb42	544	# ----------------------------------------------------
d529894e	545	# Where man is not nature is barren.
d529894e	546	# William Blake
8ccdeb42	547	# ----------------------------------------------------
16dc9970	548
d529894e	549	=pod
16dc9970	550
	551	=head1 AUTHOR
	552
d529894e	553	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
8ccdeb42	554	Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
16dc9970	555
	556	=head1 SEE ALSO
	557
8ccdeb42	558	perl(1), Parse::RecDescent, SQL::Translator::Schema.
16dc9970	559
16dc9970	560	=cut