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

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

# -------------------------------------------------------------------
# $Id: MySQL.pm,v 1.18 2003-05-09 19:51:04 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.18 $ =~ /(\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;

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

        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'},
            );
        }
    }

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