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

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

# -------------------------------------------------------------------
# $Id: MySQL.pm,v 1.16 2003-05-03 15:02:15 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.16 $ =~ /(\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.

my $parser; # should we do this?  There's no programmic way to 
            # change the grammar, so I think this is safe.

$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_table 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[4] } ) {
            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 ],
                        }
                    ;
                }
            }
            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;
    }

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
    | 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 = [];
        }

        $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

field_size   : '(' num_range ')' { $item{'num_range'} }

num_range    : DIGITS ',' DIGITS
    { $return = $item[1].','.$item[3] }
    | DIGITS
    { $return = $item[1] }

create_table : /create/i /table/i

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 }

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] }
    }

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' }
#    {
#        {
#            value     => $item[1],
#            attribute => $item[2]
#        }
#    }

!;

# -------------------------------------------------------------------
sub parse {
    my ( $translator, $data ) = @_;
    $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);
    die "Parse failed.\n" unless defined $result;
    warn Dumper($result) if $DEBUG;
    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

=head1 SEE ALSO

perl(1), Parse::RecDescent.

=cut
Commit	Line	Data
16dc9970	1	package SQL::Translator::Parser::MySQL;
16dc9970	2
49e1eb70	3	# -------------------------------------------------------------------
be019aae	4	# $Id: MySQL.pm,v 1.16 2003-05-03 15:02:15 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 ];
be019aae	126	$VERSION = sprintf "%d.%02d", q$Revision: 1.16 $ =~ /(\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
077ebf34	141	my $parser; # should we do this? There's no programmic way to
077ebf34	142	# change the grammar, so I think this is safe.
16dc9970	143
d529894e	144	$GRAMMAR = q!
	145
	146	{ our ( %tables, $table_order ) }
	147
629b76f9	148	#
	149	# The "eofile" rule makes the parser fail if any "statement" rule
	150	# fails. Otherwise, the first successful match by a "statement"
	151	# won't cause the failure needed to know that the parse, as a whole,
	152	# failed. -ky
	153	#
	154	startrule : statement(s) eofile { \%tables }
	155
	156	eofile : /^\Z/
d529894e	157
d529894e	158	statement : comment
61745327	159	\| drop
d529894e	160	\| create
	161	\| <error>
	162
61745327	163	drop : /drop/i WORD(s) ';'
61745327	164
d529894e	165	create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
	166	{
	167	my $table_name = $item{'table_name'};
	168	$tables{ $table_name }{'order'} = ++$table_order;
	169	$tables{ $table_name }{'table_name'} = $table_name;
	170
61745327	171	my $i = 1;
d529894e	172	for my $definition ( @{ $item[4] } ) {
	173	if ( $definition->{'type'} eq 'field' ) {
	174	my $field_name = $definition->{'name'};
	175	$tables{ $table_name }{'fields'}{ $field_name } =
	176	{ %$definition, order => $i };
	177	$i++;
	178
	179	if ( $definition->{'is_primary_key'} ) {
	180	push @{ $tables{ $table_name }{'indices'} },
	181	{
	182	type => 'primary_key',
	183	fields => [ $field_name ],
16dc9970	184	}
d529894e	185	;
d529894e	186	}
dd2ef5ae	187	}
d529894e	188	else {
	189	push @{ $tables{ $table_name }{'indices'} },
	190	$definition;
dd2ef5ae	191	}
d529894e	192	}
dd2ef5ae	193
58a88238	194	for my $opt ( @{ $item{'table_option(s?)'} } ) {
d529894e	195	if ( my ( $key, $val ) = each %$opt ) {
d529894e	196	$tables{ $table_name }{'table_options'}{ $key } = $val;
dd2ef5ae	197	}
d529894e	198	}
58a88238	199
58a88238	200	1;
d529894e	201	}
dd2ef5ae	202
d529894e	203	create : /CREATE/i unique(?) /(INDEX\|KEY)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
	204	{
	205	push @{ $tables{ $item{'table_name'} }{'indices'} },
	206	{
	207	name => $item[4],
	208	type => $item[2] ? 'unique' : 'normal',
	209	fields => $item[8],
dd2ef5ae	210	}
d529894e	211	;
d529894e	212	}
dd2ef5ae	213
d529894e	214	create_definition : index
	215	\| field
	216	\| <error>
	217
	218	comment : /^\s(?:#\|-{2}).\n/
	219
	220	blank : /\s*/
	221
658637cd	222	field : field_name data_type field_qualifier(s?) reference_definition(?)
d529894e	223	{
58a88238	224	my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} \|\| [] };
d529894e	225	my $null = defined $item{'not_null'} ? $item{'not_null'} : 1;
	226	delete $qualifiers{'not_null'};
	227	if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} \|\| [] } ) {
	228	$qualifiers{ $_ } = 1 for @type_quals;
	229	}
	230
	231	$return = {
	232	type => 'field',
	233	name => $item{'field_name'},
	234	data_type => $item{'data_type'}{'type'},
	235	size => $item{'data_type'}{'size'},
	236	list => $item{'data_type'}{'list'},
	237	null => $null,
58a88238	238	constraints => $item{'reference_definition(?)'},
d529894e	239	%qualifiers,
	240	}
	241	}
	242	\| <error>
dd2ef5ae	243
d529894e	244	field_qualifier : not_null
	245	{
	246	$return = {
	247	null => $item{'not_null'},
	248	}
	249	}
16dc9970	250
d529894e	251	field_qualifier : default_val
	252	{
	253	$return = {
	254	default => $item{'default_val'},
	255	}
	256	}
16dc9970	257
d529894e	258	field_qualifier : auto_inc
	259	{
	260	$return = {
	261	is_auto_inc => $item{'auto_inc'},
	262	}
	263	}
16dc9970	264
d529894e	265	field_qualifier : primary_key
	266	{
	267	$return = {
	268	is_primary_key => $item{'primary_key'},
	269	}
	270	}
16dc9970	271
d529894e	272	field_qualifier : unsigned
	273	{
	274	$return = {
	275	is_unsigned => $item{'unsigned'},
	276	}
	277	}
16dc9970	278
658637cd	279	reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
	280	{
	281	$return = {
	282	type => 'foreign_key',
	283	reference_table => $item[2],
	284	reference_fields => $item[3][0],
	285	match_type => $item[4][0],
	286	on_delete_do => $item[5][0],
	287	on_update_do => $item[6][0],
	288	}
	289	}
	290
	291	match_type : /match full/i { 'match_full' }
	292	\|
	293	/match partial/i { 'match_partial' }
	294
	295	on_delete_do : /on delete/i reference_option
	296	{ $item[2] }
	297
	298	on_update_do : /on update/i reference_option
	299	{ $item[2] }
	300
	301	reference_option: /restrict/i \|
	302	/cascade/i \|
	303	/set null/i \|
	304	/no action/i \|
	305	/set default/i
	306	{ $item[1] }
	307
d529894e	308	index : primary_key_index
d529894e	309	\| unique_index
371f5f88	310	\| fulltext_index
d529894e	311	\| normal_index
58a88238	312	\| <error>
d529894e	313
	314	table_name : WORD
	315
	316	field_name : WORD
	317
	318	index_name : WORD
	319
	320	data_type : WORD parens_value_list(s?) type_qualifier(s?)
	321	{
	322	my $type = $item[1];
	323	my $size; # field size, applicable only to non-set fields
	324	my $list; # set list, applicable only to sets (duh)
	325
44fcd0b5	326	if ( uc($type) =~ /^(SET\|ENUM)$/ ) {
d529894e	327	$size = undef;
	328	$list = $item[2][0];
	329	}
	330	else {
	331	$size = $item[2][0];
	332	$list = [];
	333	}
	334
	335	$return = {
	336	type => $type,
	337	size => $size,
	338	list => $list,
	339	qualifiers => $item[3],
	340	}
	341	}
16dc9970	342
658637cd	343	parens_field_list : '(' field_name(s /,/) ')'
	344	{ $item[2] }
	345
d529894e	346	parens_value_list : '(' VALUE(s /,/) ')'
d529894e	347	{ $item[2] }
16dc9970	348
d529894e	349	type_qualifier : /(BINARY\|UNSIGNED\|ZEROFILL)/i
d529894e	350	{ lc $item[1] }
16dc9970	351
d529894e	352	field_type : WORD
16dc9970	353
d529894e	354	field_size : '(' num_range ')' { $item{'num_range'} }
16dc9970	355
d529894e	356	num_range : DIGITS ',' DIGITS
	357	{ $return = $item[1].','.$item[3] }
	358	\| DIGITS
	359	{ $return = $item[1] }
dd2ef5ae	360
d529894e	361	create_table : /create/i /table/i
16dc9970	362
d529894e	363	create_index : /create/i /index/i
dd2ef5ae	364
d529894e	365	not_null : /not/i /null/i { $return = 0 }
16dc9970	366
d529894e	367	unsigned : /unsigned/i { $return = 0 }
16dc9970	368
be019aae	369	default_val : /default/i /(?:')?[\w\d:.-]*(?:')?/
d529894e	370	{
	371	$item[2] =~ s/'//g;
	372	$return = $item[2];
	373	}
16dc9970	374
d529894e	375	auto_inc : /auto_increment/i { 1 }
16dc9970	376
d529894e	377	primary_key : /primary/i /key/i { 1 }
16dc9970	378
d529894e	379	primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
	380	{
	381	$return = {
58a88238	382	name => $item{'index_name(?)'}[0],
d529894e	383	type => 'primary_key',
d529894e	384	fields => $item[4],
58a88238	385	};
d529894e	386	}
16dc9970	387
d529894e	388	normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
	389	{
	390	$return = {
58a88238	391	name => $item{'index_name(?)'}[0],
d529894e	392	type => 'normal',
	393	fields => $item[4],
	394	}
	395	}
16dc9970	396
d529894e	397	unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
	398	{
	399	$return = {
58a88238	400	name => $item{'index_name(?)'}[0],
d529894e	401	type => 'unique',
	402	fields => $item[5],
	403	}
	404	}
16dc9970	405
371f5f88	406	fulltext_index : fulltext key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
	407	{
	408	$return = {
58a88238	409	name => $item{'index_name(?)'}[0],
371f5f88	410	type => 'fulltext',
	411	fields => $item[5],
	412	}
	413	}
	414
d529894e	415	name_with_opt_paren : NAME parens_value_list(s?)
d529894e	416	{ $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
16dc9970	417
371f5f88	418	fulltext : /fulltext/i { 1 }
371f5f88	419
d529894e	420	unique : /unique/i { 1 }
16dc9970	421
d529894e	422	key : /key/i \| /index/i
16dc9970	423
44fcd0b5	424	table_option : /[^\s;]*/
d529894e	425	{
	426	$return = { split /=/, $item[1] }
	427	}
16dc9970	428
d529894e	429	WORD : /\w+/
16dc9970	430
d529894e	431	DIGITS : /\d+/
16dc9970	432
d529894e	433	COMMA : ','
16dc9970	434
d529894e	435	NAME : "`" /\w+/ "`"
	436	{ $item[2] }
	437	\| /\w+/
	438	{ $item[1] }
16dc9970	439
d529894e	440	VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
	441	{ $item[1] }
	442	\| /'.*?'/ # XXX doesn't handle embedded quotes
	443	{ $item[1] }
	444	\| /NULL/
	445	{ 'NULL' }
658637cd	446	# {
	447	# {
	448	# value => $item[1],
	449	# attribute => $item[2]
	450	# }
	451	# }
16dc9970	452
d529894e	453	!;
16dc9970	454
d529894e	455	# -------------------------------------------------------------------
	456	sub parse {
	457	my ( $translator, $data ) = @_;
	458	$parser \|\|= Parse::RecDescent->new($GRAMMAR);
077ebf34	459
e099bee9	460	local $::RD_TRACE = $translator->trace ? 1 : undef;
e099bee9	461	local $DEBUG = $translator->debug;
d529894e	462
	463	unless (defined $parser) {
	464	return $translator->error("Error instantiating Parse::RecDescent ".
	465	"instance: Bad grammer");
	466	}
	467
	468	my $result = $parser->startrule($data);
	469	die "Parse failed.\n" unless defined $result;
	470	warn Dumper($result) if $DEBUG;
	471	return $result;
	472	}
	473
	474	1;
	475
	476	#-----------------------------------------------------
	477	# Where man is not nature is barren.
	478	# William Blake
	479	#-----------------------------------------------------
16dc9970	480
d529894e	481	=pod
16dc9970	482
	483	=head1 AUTHOR
	484
d529894e	485	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
d529894e	486	Chris Mungall
16dc9970	487
	488	=head1 SEE ALSO
	489
d529894e	490	perl(1), Parse::RecDescent.
16dc9970	491
16dc9970	492	=cut