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

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

# -------------------------------------------------------------------
# $Id: MySQL.pm,v 1.14 2003-04-07 16:27:30 dlc 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.14 $ =~ /(\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'} } ) {
            if ( my ( $key, $val ) = each %$opt ) {
                $tables{ $table_name }{'table_options'}{ $key } = $val;
            }
        }
    }

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

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