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

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

# -------------------------------------------------------------------
# $Id: MySQL.pm,v 1.12 2003-02-25 14:55:35 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.12 $ =~ /(\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?)
    { 
        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,
            %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'},
        } 
    }

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_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' }

!;

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

    $::RD_TRACE  = $translator->trace ? 1 : undef;
    $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	# -------------------------------------------------------------------
629b76f9	4	# $Id: MySQL.pm,v 1.12 2003-02-25 14:55:35 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 ];
629b76f9	126	$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\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
	220	field : field_name data_type field_qualifier(s?)
	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,
	236	%qualifiers,
	237	}
	238	}
	239	\| <error>
dd2ef5ae	240
d529894e	241	field_qualifier : not_null
	242	{
	243	$return = {
	244	null => $item{'not_null'},
	245	}
	246	}
16dc9970	247
d529894e	248	field_qualifier : default_val
	249	{
	250	$return = {
	251	default => $item{'default_val'},
	252	}
	253	}
16dc9970	254
d529894e	255	field_qualifier : auto_inc
	256	{
	257	$return = {
	258	is_auto_inc => $item{'auto_inc'},
	259	}
	260	}
16dc9970	261
d529894e	262	field_qualifier : primary_key
	263	{
	264	$return = {
	265	is_primary_key => $item{'primary_key'},
	266	}
	267	}
16dc9970	268
d529894e	269	field_qualifier : unsigned
	270	{
	271	$return = {
	272	is_unsigned => $item{'unsigned'},
	273	}
	274	}
16dc9970	275
d529894e	276	index : primary_key_index
d529894e	277	\| unique_index
371f5f88	278	\| fulltext_index
d529894e	279	\| normal_index
	280
	281	table_name : WORD
	282
	283	field_name : WORD
	284
	285	index_name : WORD
	286
	287	data_type : WORD parens_value_list(s?) type_qualifier(s?)
	288	{
	289	my $type = $item[1];
	290	my $size; # field size, applicable only to non-set fields
	291	my $list; # set list, applicable only to sets (duh)
	292
44fcd0b5	293	if ( uc($type) =~ /^(SET\|ENUM)$/ ) {
d529894e	294	$size = undef;
	295	$list = $item[2][0];
	296	}
	297	else {
	298	$size = $item[2][0];
	299	$list = [];
	300	}
	301
	302	$return = {
	303	type => $type,
	304	size => $size,
	305	list => $list,
	306	qualifiers => $item[3],
	307	}
	308	}
16dc9970	309
d529894e	310	parens_value_list : '(' VALUE(s /,/) ')'
d529894e	311	{ $item[2] }
16dc9970	312
d529894e	313	type_qualifier : /(BINARY\|UNSIGNED\|ZEROFILL)/i
d529894e	314	{ lc $item[1] }
16dc9970	315
d529894e	316	field_type : WORD
16dc9970	317
d529894e	318	field_size : '(' num_range ')' { $item{'num_range'} }
16dc9970	319
d529894e	320	num_range : DIGITS ',' DIGITS
	321	{ $return = $item[1].','.$item[3] }
	322	\| DIGITS
	323	{ $return = $item[1] }
dd2ef5ae	324
d529894e	325	create_table : /create/i /table/i
16dc9970	326
d529894e	327	create_index : /create/i /index/i
dd2ef5ae	328
d529894e	329	not_null : /not/i /null/i { $return = 0 }
16dc9970	330
d529894e	331	unsigned : /unsigned/i { $return = 0 }
16dc9970	332
d529894e	333	default_val : /default/i /(?:')?[\w\d.-]*(?:')?/
	334	{
	335	$item[2] =~ s/'//g;
	336	$return = $item[2];
	337	}
16dc9970	338
d529894e	339	auto_inc : /auto_increment/i { 1 }
16dc9970	340
d529894e	341	primary_key : /primary/i /key/i { 1 }
16dc9970	342
d529894e	343	primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
	344	{
	345	$return = {
	346	name => $item{'index_name'}[0],
	347	type => 'primary_key',
	348	fields => $item[4],
	349	}
	350	}
16dc9970	351
d529894e	352	normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
	353	{
	354	$return = {
	355	name => $item{'index_name'}[0],
	356	type => 'normal',
	357	fields => $item[4],
	358	}
	359	}
16dc9970	360
d529894e	361	unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
	362	{
	363	$return = {
	364	name => $item{'index_name'}[0],
	365	type => 'unique',
	366	fields => $item[5],
	367	}
	368	}
16dc9970	369
371f5f88	370	fulltext_index : fulltext key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
	371	{
	372	$return = {
	373	name => $item{'index_name'}[0],
	374	type => 'fulltext',
	375	fields => $item[5],
	376	}
	377	}
	378
d529894e	379	name_with_opt_paren : NAME parens_value_list(s?)
d529894e	380	{ $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
16dc9970	381
371f5f88	382	fulltext : /fulltext/i { 1 }
371f5f88	383
d529894e	384	unique : /unique/i { 1 }
16dc9970	385
d529894e	386	key : /key/i \| /index/i
16dc9970	387
44fcd0b5	388	table_option : /[^\s;]*/
d529894e	389	{
	390	$return = { split /=/, $item[1] }
	391	}
16dc9970	392
d529894e	393	WORD : /\w+/
16dc9970	394
d529894e	395	DIGITS : /\d+/
16dc9970	396
d529894e	397	COMMA : ','
16dc9970	398
d529894e	399	NAME : "`" /\w+/ "`"
	400	{ $item[2] }
	401	\| /\w+/
	402	{ $item[1] }
16dc9970	403
d529894e	404	VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
	405	{ $item[1] }
	406	\| /'.*?'/ # XXX doesn't handle embedded quotes
	407	{ $item[1] }
	408	\| /NULL/
	409	{ 'NULL' }
16dc9970	410
d529894e	411	!;
16dc9970	412
d529894e	413	# -------------------------------------------------------------------
	414	sub parse {
	415	my ( $translator, $data ) = @_;
	416	$parser \|\|= Parse::RecDescent->new($GRAMMAR);
077ebf34	417
d529894e	418	$::RD_TRACE = $translator->trace ? 1 : undef;
	419	$DEBUG = $translator->debug;
	420
	421	unless (defined $parser) {
	422	return $translator->error("Error instantiating Parse::RecDescent ".
	423	"instance: Bad grammer");
	424	}
	425
	426	my $result = $parser->startrule($data);
	427	die "Parse failed.\n" unless defined $result;
	428	warn Dumper($result) if $DEBUG;
	429	return $result;
	430	}
	431
	432	1;
	433
	434	#-----------------------------------------------------
	435	# Where man is not nature is barren.
	436	# William Blake
	437	#-----------------------------------------------------
16dc9970	438
d529894e	439	=pod
16dc9970	440
	441	=head1 AUTHOR
	442
d529894e	443	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
d529894e	444	Chris Mungall
16dc9970	445
	446	=head1 SEE ALSO
	447
d529894e	448	perl(1), Parse::RecDescent.
16dc9970	449
16dc9970	450	=cut