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

package SQL::Translator::Parser::Access;

=head1 NAME

SQL::Translator::Parser::Access - parser for Access as produced by mdbtools

=head1 SYNOPSIS

  use SQL::Translator;
  use SQL::Translator::Parser::Access;

  my $translator = SQL::Translator->new;
  $translator->parser("SQL::Translator::Parser::Access");

=head1 DESCRIPTION

The grammar derived from the MySQL grammar.  The input is expected to be
something similar to the output of mdbtools (http://mdbtools.sourceforge.net/).

=cut

use strict;
use warnings;

our $VERSION = '1.59';

our $DEBUG;
$DEBUG = 0 unless defined $DEBUG;

use Data::Dumper;
use SQL::Translator::Utils qw/ddl_parser_instance/;

use base qw(Exporter);
our @EXPORT_OK = qw(parse);

our $GRAMMAR = <<'END_OF_GRAMMAR';

{
    my ( %tables, $table_order, @table_comments );
}

#
# 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
    | use
    | set
    | drop
    | create
    | <error>

use : /use/i WORD ';'
    { @table_comments = () }

set : /set/i /[^;]+/ ';'
    { @table_comments = () }

drop : /drop/i TABLE /[^;]+/ ';'

drop : /drop/i WORD(s) ';'
    { @table_comments = () }

create : CREATE /database/i WORD ';'
    { @table_comments = () }

create : CREATE TABLE table_name '(' create_definition(s /,/) ')' ';'
    {
        my $table_name                       = $item{'table_name'};
        $tables{ $table_name }{'order'}      = ++$table_order;
        $tables{ $table_name }{'table_name'} = $table_name;

        if ( @table_comments ) {
            $tables{ $table_name }{'comments'} = [ @table_comments ];
            @table_comments = ();
        }

        my $i = 1;
        for my $definition ( @{ $item[5] } ) {
            if ( $definition->{'supertype'} 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 }{'constraints'} },
                        {
                            type   => 'primary_key',
                            fields => [ $field_name ],
                        }
                    ;
                }
            }
            elsif ( $definition->{'supertype'} eq 'constraint' ) {
                push @{ $tables{ $table_name }{'constraints'} }, $definition;
            }
            elsif ( $definition->{'supertype'} eq 'index' ) {
                push @{ $tables{ $table_name }{'indices'} }, $definition;
            }
        }

        1;
    }

create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
    {
        @table_comments = ();
        push @{ $tables{ $item{'table_name'} }{'indices'} },
            {
                name   => $item[4],
                type   => $item[2] ? 'unique' : 'normal',
                fields => $item[8],
            }
        ;
    }

create_definition : constraint
    | index
    | field
    | comment
    | <error>

comment : /^\s*--(.*)\n/
    {
        my $comment =  $1;
        $return     = $comment;
        push @table_comments, $comment;
    }

field : field_name data_type field_qualifier(s?) reference_definition(?)
    {
        $return = {
            supertype   => 'field',
            name        => $item{'field_name'},
            data_type   => $item{'data_type'}{'type'},
            size        => $item{'data_type'}{'size'},
            constraints => $item{'reference_definition(?)'},
        }
    }
    | <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'},
        }
    }

field_qualifier : /character set/i WORD
    {
        $return = {
            character_set => $item[2],
        }
    }

reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
    {
        $return = {
            type             => 'foreign_key',
            reference_table  => $item[2],
            reference_fields => $item[3][0],
            match_type       => $item[4][0],
            on_delete        => $item[5][0],
            on_update        => $item[6][0],
        }
    }

match_type : /match full/i { 'full' }
    |
    /match partial/i { 'partial' }

on_delete : /on delete/i reference_option
    { $item[2] }

on_update : /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 : normal_index
    | fulltext_index
    | <error>

table_name   : NAME

field_name   : NAME

index_name   : NAME

data_type    : access_data_type parens_value_list(s?) type_qualifier(s?)
    {
        $return        = {
            type       => $item[1],
            size       => $item[2][0],
            qualifiers => $item[3],
        }
    }

access_data_type : /long integer/i { $return = 'Long Integer' }
    | /text/i { $return = 'Text' }
    | /datetime (\(short\))?/i { $return = 'DateTime' }
    | /boolean/i { $return = 'Boolean' }
    | WORD

parens_field_list : '(' field_name(s /,/) ')'
    { $item[2] }

parens_value_list : '(' VALUE(s /,/) ')'
    { $item[2] }

type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
    { lc $item[1] }

field_type   : WORD

create_index : /create/i /index/i

not_null     : /not/i /null/i { $return = 0 }

unsigned     : /unsigned/i { $return = 0 }

default_val : /default/i /'(?:.*?\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
    {
        $item[2] =~ s/^\s*'|'\s*$//g;
        $return  =  $item[2];
    }

auto_inc : /auto_increment/i { 1 }

primary_key : /primary/i /key/i { 1 }

constraint : primary_key_def
    | unique_key_def
    | foreign_key_def
    | <error>

foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
    {
        $return              =  {
            supertype        => 'constraint',
            type             => 'foreign_key',
            name             => $item[1],
            fields           => $item[2],
            %{ $item{'reference_definition'} },
        }
    }

foreign_key_def_begin : /constraint/i /foreign key/i
    { $return = '' }
    |
    /constraint/i WORD /foreign key/i
    { $return = $item[2] }
    |
    /foreign key/i
    { $return = '' }

primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
    {
        $return       = {
            supertype => 'constraint',
            name      => $item{'index_name(?)'}[0],
            type      => 'primary_key',
            fields    => $item[4],
        };
    }

unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
    {
        $return       = {
            supertype => 'constraint',
            name      => $item{'index_name(?)'}[0],
            type      => 'unique',
            fields    => $item[5],
        }
    }

normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
    {
        $return       = {
            supertype => 'index',
            type      => 'normal',
            name      => $item{'index_name(?)'}[0],
            fields    => $item[4],
        }
    }

fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
    {
        $return       = {
            supertype => 'index',
            type      => 'fulltext',
            name      => $item{'index_name(?)'}[0],
            fields    => $item[5],
        }
    }

name_with_opt_paren : NAME parens_value_list(s?)
    { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }

UNIQUE : /unique/i { 1 }

KEY : /key/i | /index/i

table_option : WORD /\s*=\s*/ WORD
    {
        $return = { $item[1] => $item[3] };
    }

CREATE : /create/i

TEMPORARY : /temporary/i

TABLE : /table/i

WORD : /\w+/

DIGITS : /\d+/

COMMA : ','

NAME    : "`" /\w+/ "`"
    { $item[2] }
    | /\w+/
    { $item[1] }

VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
    { $item[1] }
    | /'.*?'/
    {
        # remove leading/trailing quotes
        my $val = $item[1];
        $val    =~ s/^['"]|['"]$//g;
        $return = $val;
    }
    | /NULL/
    { 'NULL' }

END_OF_GRAMMAR

sub parse {
    my ( $translator, $data ) = @_;

    # Enable warnings within the Parse::RecDescent module.
    local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
    local $::RD_WARN   = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
    local $::RD_HINT   = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.

    local $::RD_TRACE  = $translator->trace ? 1 : undef;
    local $DEBUG       = $translator->debug;

    my $parser = ddl_parser_instance('Access');

    my $result = $parser->startrule($data);
    return $translator->error( "Parse failed." ) unless defined $result;
    warn Dumper( $result ) if $DEBUG;

    my $schema = $translator->schema;
    my @tables = sort {
        $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
    } keys %{ $result };

    for my $table_name ( @tables ) {
        my $tdata =  $result->{ $table_name };
        my $table =  $schema->add_table(
            name  => $tdata->{'table_name'},
        ) or die $schema->error;

        $table->comments( $tdata->{'comments'} );

        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'},
                comments          => $fdata->{'comments'},
            ) or die $table->error;

            $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
        }

        for my $idata ( @{ $tdata->{'indices'} || [] } ) {
            my $index  =  $table->add_index(
                name   => $idata->{'name'},
                type   => uc $idata->{'type'},
                fields => $idata->{'fields'},
            ) or die $table->error;
        }
    }

    return 1;
}

1;

# -------------------------------------------------------------------
# Where man is not nature is barren.
# William Blake
# -------------------------------------------------------------------

=pod

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.

=head1 SEE ALSO

perl(1), Parse::RecDescent, SQL::Translator::Schema.

=cut
Commit	Line	Data
7c44825c	1	package SQL::Translator::Parser::Access;
7c44825c	2
7c44825c	3	=head1 NAME
	4
	5	SQL::Translator::Parser::Access - parser for Access as produced by mdbtools
	6
	7	=head1 SYNOPSIS
	8
	9	use SQL::Translator;
	10	use SQL::Translator::Parser::Access;
	11
	12	my $translator = SQL::Translator->new;
	13	$translator->parser("SQL::Translator::Parser::Access");
	14
	15	=head1 DESCRIPTION
	16
ea93df61	17	The grammar derived from the MySQL grammar. The input is expected to be
7c44825c	18	something similar to the output of mdbtools (http://mdbtools.sourceforge.net/).
	19
	20	=cut
	21
	22	use strict;
f27f9229	23	use warnings;
bdf60588	24
0c04c5a2	25	our $VERSION = '1.59';
7c44825c	26
bdf60588	27	our $DEBUG;
bdf60588	28	$DEBUG = 0 unless defined $DEBUG;
7c44825c	29
bdf60588	30	use Data::Dumper;
bdf60588	31	use SQL::Translator::Utils qw/ddl_parser_instance/;
7c44825c	32
bdf60588	33	use base qw(Exporter);
bdf60588	34	our @EXPORT_OK = qw(parse);
7c44825c	35
bdf60588	36	our $GRAMMAR = <<'END_OF_GRAMMAR';
7c44825c	37
ea93df61	38	{
7c44825c	39	my ( %tables, $table_order, @table_comments );
	40	}
	41
	42	#
	43	# The "eofile" rule makes the parser fail if any "statement" rule
ea93df61	44	# fails. Otherwise, the first successful match by a "statement"
7c44825c	45	# won't cause the failure needed to know that the parse, as a whole,
	46	# failed. -ky
	47	#
	48	startrule : statement(s) eofile { \%tables }
	49
	50	eofile : /^\Z/
	51
	52	statement : comment
	53	\| use
	54	\| set
	55	\| drop
	56	\| create
	57	\| <error>
	58
	59	use : /use/i WORD ';'
	60	{ @table_comments = () }
	61
	62	set : /set/i /[^;]+/ ';'
	63	{ @table_comments = () }
	64
	65	drop : /drop/i TABLE /[^;]+/ ';'
	66
	67	drop : /drop/i WORD(s) ';'
	68	{ @table_comments = () }
	69
	70	create : CREATE /database/i WORD ';'
	71	{ @table_comments = () }
	72
	73	create : CREATE TABLE table_name '(' create_definition(s /,/) ')' ';'
ea93df61	74	{
7c44825c	75	my $table_name = $item{'table_name'};
	76	$tables{ $table_name }{'order'} = ++$table_order;
	77	$tables{ $table_name }{'table_name'} = $table_name;
	78
	79	if ( @table_comments ) {
	80	$tables{ $table_name }{'comments'} = [ @table_comments ];
	81	@table_comments = ();
	82	}
	83
	84	my $i = 1;
	85	for my $definition ( @{ $item[5] } ) {
	86	if ( $definition->{'supertype'} eq 'field' ) {
	87	my $field_name = $definition->{'name'};
ea93df61	88	$tables{ $table_name }{'fields'}{ $field_name } =
7c44825c	89	{ %$definition, order => $i };
7c44825c	90	$i++;
ea93df61	91
7c44825c	92	if ( $definition->{'is_primary_key'} ) {
	93	push @{ $tables{ $table_name }{'constraints'} },
	94	{
	95	type => 'primary_key',
	96	fields => [ $field_name ],
	97	}
	98	;
	99	}
	100	}
	101	elsif ( $definition->{'supertype'} eq 'constraint' ) {
	102	push @{ $tables{ $table_name }{'constraints'} }, $definition;
	103	}
	104	elsif ( $definition->{'supertype'} eq 'index' ) {
	105	push @{ $tables{ $table_name }{'indices'} }, $definition;
	106	}
	107	}
	108
	109	1;
	110	}
	111
	112	create : CREATE UNIQUE(?) /(index\|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
	113	{
	114	@table_comments = ();
	115	push @{ $tables{ $item{'table_name'} }{'indices'} },
	116	{
	117	name => $item[4],
	118	type => $item[2] ? 'unique' : 'normal',
	119	fields => $item[8],
	120	}
	121	;
	122	}
	123
ea93df61	124	create_definition : constraint
7c44825c	125	\| index
	126	\| field
	127	\| comment
	128	\| <error>
	129
ea93df61	130	comment : /^\s--(.)\n/
ea93df61	131	{
7c44825c	132	my $comment = $1;
	133	$return = $comment;
	134	push @table_comments, $comment;
	135	}
	136
	137	field : field_name data_type field_qualifier(s?) reference_definition(?)
ea93df61	138	{
ea93df61	139	$return = {
7c44825c	140	supertype => 'field',
ea93df61	141	name => $item{'field_name'},
7c44825c	142	data_type => $item{'data_type'}{'type'},
7c44825c	143	size => $item{'data_type'}{'size'},
7c44825c	144	constraints => $item{'reference_definition(?)'},
ea93df61	145	}
7c44825c	146	}
	147	\| <error>
	148
	149	field_qualifier : not_null
ea93df61	150	{
ea93df61	151	$return = {
7c44825c	152	null => $item{'not_null'},
ea93df61	153	}
7c44825c	154	}
	155
	156	field_qualifier : default_val
ea93df61	157	{
ea93df61	158	$return = {
7c44825c	159	default => $item{'default_val'},
ea93df61	160	}
7c44825c	161	}
	162
	163	field_qualifier : auto_inc
ea93df61	164	{
ea93df61	165	$return = {
7c44825c	166	is_auto_inc => $item{'auto_inc'},
ea93df61	167	}
7c44825c	168	}
	169
	170	field_qualifier : primary_key
ea93df61	171	{
ea93df61	172	$return = {
7c44825c	173	is_primary_key => $item{'primary_key'},
ea93df61	174	}
7c44825c	175	}
	176
	177	field_qualifier : unsigned
ea93df61	178	{
ea93df61	179	$return = {
7c44825c	180	is_unsigned => $item{'unsigned'},
ea93df61	181	}
7c44825c	182	}
	183
	184	field_qualifier : /character set/i WORD
	185	{
	186	$return = {
	187	character_set => $item[2],
	188	}
	189	}
	190
100684f3	191	reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
7c44825c	192	{
	193	$return = {
	194	type => 'foreign_key',
	195	reference_table => $item[2],
	196	reference_fields => $item[3][0],
	197	match_type => $item[4][0],
100684f3	198	on_delete => $item[5][0],
100684f3	199	on_update => $item[6][0],
7c44825c	200	}
	201	}
	202
	203	match_type : /match full/i { 'full' }
	204	\|
	205	/match partial/i { 'partial' }
	206
100684f3	207	on_delete : /on delete/i reference_option
7c44825c	208	{ $item[2] }
7c44825c	209
100684f3	210	on_update : /on update/i reference_option
7c44825c	211	{ $item[2] }
7c44825c	212
ea93df61	213	reference_option: /restrict/i \|
	214	/cascade/i \|
	215	/set null/i \|
	216	/no action/i \|
7c44825c	217	/set default/i
ea93df61	218	{ $item[1] }
7c44825c	219
	220	index : normal_index
	221	\| fulltext_index
	222	\| <error>
	223
	224	table_name : NAME
	225
	226	field_name : NAME
	227
	228	index_name : NAME
	229
	230	data_type : access_data_type parens_value_list(s?) type_qualifier(s?)
ea93df61	231	{
ea93df61	232	$return = {
7c44825c	233	type => $item[1],
	234	size => $item[2][0],
	235	qualifiers => $item[3],
ea93df61	236	}
7c44825c	237	}
	238
	239	access_data_type : /long integer/i { $return = 'Long Integer' }
	240	\| /text/i { $return = 'Text' }
	241	\| /datetime (\(short\))?/i { $return = 'DateTime' }
	242	\| /boolean/i { $return = 'Boolean' }
	243	\| WORD
	244
	245	parens_field_list : '(' field_name(s /,/) ')'
	246	{ $item[2] }
	247
	248	parens_value_list : '(' VALUE(s /,/) ')'
	249	{ $item[2] }
	250
	251	type_qualifier : /(BINARY\|UNSIGNED\|ZEROFILL)/i
	252	{ lc $item[1] }
	253
	254	field_type : WORD
	255
	256	create_index : /create/i /index/i
	257
	258	not_null : /not/i /null/i { $return = 0 }
	259
	260	unsigned : /unsigned/i { $return = 0 }
	261
bdf60588	262	default_val : /default/i /'(?:.?\').?'\|(?:')?[\w\d:.-](?:')?/
7c44825c	263	{
	264	$item[2] =~ s/^\s'\|'\s$//g;
	265	$return = $item[2];
	266	}
	267
	268	auto_inc : /auto_increment/i { 1 }
	269
	270	primary_key : /primary/i /key/i { 1 }
	271
	272	constraint : primary_key_def
	273	\| unique_key_def
	274	\| foreign_key_def
	275	\| <error>
	276
	277	foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
	278	{
	279	$return = {
	280	supertype => 'constraint',
	281	type => 'foreign_key',
	282	name => $item[1],
	283	fields => $item[2],
	284	%{ $item{'reference_definition'} },
	285	}
	286	}
	287
ea93df61	288	foreign_key_def_begin : /constraint/i /foreign key/i
7c44825c	289	{ $return = '' }
	290	\|
	291	/constraint/i WORD /foreign key/i
	292	{ $return = $item[2] }
	293	\|
	294	/foreign key/i
	295	{ $return = '' }
	296
	297	primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
ea93df61	298	{
ea93df61	299	$return = {
7c44825c	300	supertype => 'constraint',
	301	name => $item{'index_name(?)'}[0],
	302	type => 'primary_key',
	303	fields => $item[4],
	304	};
	305	}
	306
	307	unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
ea93df61	308	{
ea93df61	309	$return = {
7c44825c	310	supertype => 'constraint',
	311	name => $item{'index_name(?)'}[0],
	312	type => 'unique',
	313	fields => $item[5],
ea93df61	314	}
7c44825c	315	}
	316
	317	normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
ea93df61	318	{
ea93df61	319	$return = {
7c44825c	320	supertype => 'index',
	321	type => 'normal',
	322	name => $item{'index_name(?)'}[0],
	323	fields => $item[4],
ea93df61	324	}
7c44825c	325	}
	326
	327	fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
ea93df61	328	{
ea93df61	329	$return = {
7c44825c	330	supertype => 'index',
	331	type => 'fulltext',
	332	name => $item{'index_name(?)'}[0],
	333	fields => $item[5],
ea93df61	334	}
7c44825c	335	}
	336
	337	name_with_opt_paren : NAME parens_value_list(s?)
	338	{ $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
	339
	340	UNIQUE : /unique/i { 1 }
	341
	342	KEY : /key/i \| /index/i
	343
	344	table_option : WORD /\s=\s/ WORD
ea93df61	345	{
7c44825c	346	$return = { $item[1] => $item[3] };
	347	}
	348
	349	CREATE : /create/i
	350
	351	TEMPORARY : /temporary/i
	352
	353	TABLE : /table/i
	354
	355	WORD : /\w+/
	356
	357	DIGITS : /\d+/
	358
	359	COMMA : ','
	360
	361	NAME : "`" /\w+/ "`"
	362	{ $item[2] }
	363	\| /\w+/
	364	{ $item[1] }
	365
	366	VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
	367	{ $item[1] }
ea93df61	368	\| /'.*?'/
	369	{
	370	# remove leading/trailing quotes
7c44825c	371	my $val = $item[1];
	372	$val =~ s/^['"]\|['"]$//g;
	373	$return = $val;
	374	}
	375	\| /NULL/
	376	{ 'NULL' }
	377
bdf60588	378	END_OF_GRAMMAR
7c44825c	379
7c44825c	380	sub parse {
7c44825c	381	my ( $translator, $data ) = @_;
bdf60588	382
	383	# Enable warnings within the Parse::RecDescent module.
	384	local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
	385	local $::RD_WARN = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
	386	local $::RD_HINT = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.
7c44825c	387
	388	local $::RD_TRACE = $translator->trace ? 1 : undef;
	389	local $DEBUG = $translator->debug;
	390
bdf60588	391	my $parser = ddl_parser_instance('Access');
7c44825c	392
	393	my $result = $parser->startrule($data);
	394	return $translator->error( "Parse failed." ) unless defined $result;
	395	warn Dumper( $result ) if $DEBUG;
	396
	397	my $schema = $translator->schema;
ea93df61	398	my @tables = sort {
7c44825c	399	$result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
	400	} keys %{ $result };
	401
	402	for my $table_name ( @tables ) {
	403	my $tdata = $result->{ $table_name };
ea93df61	404	my $table = $schema->add_table(
7c44825c	405	name => $tdata->{'table_name'},
	406	) or die $schema->error;
	407
	408	$table->comments( $tdata->{'comments'} );
	409
ea93df61	410	my @fields = sort {
ea93df61	411	$tdata->{'fields'}->{$a}->{'order'}
7c44825c	412	<=>
	413	$tdata->{'fields'}->{$b}->{'order'}
	414	} keys %{ $tdata->{'fields'} };
	415
	416	for my $fname ( @fields ) {
	417	my $fdata = $tdata->{'fields'}{ $fname };
	418	my $field = $table->add_field(
	419	name => $fdata->{'name'},
	420	data_type => $fdata->{'data_type'},
	421	size => $fdata->{'size'},
	422	default_value => $fdata->{'default'},
	423	is_auto_increment => $fdata->{'is_auto_inc'},
	424	is_nullable => $fdata->{'null'},
	425	comments => $fdata->{'comments'},
	426	) or die $table->error;
	427
	428	$table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
7c44825c	429	}
	430
	431	for my $idata ( @{ $tdata->{'indices'} \|\| [] } ) {
	432	my $index = $table->add_index(
	433	name => $idata->{'name'},
	434	type => uc $idata->{'type'},
	435	fields => $idata->{'fields'},
	436	) or die $table->error;
	437	}
7c44825c	438	}
	439
	440	return 1;
	441	}
	442
	443	1;
	444
	445	# -------------------------------------------------------------------
	446	# Where man is not nature is barren.
	447	# William Blake
	448	# -------------------------------------------------------------------
	449
	450	=pod
	451
	452	=head1 AUTHOR
	453
11ad2df9	454	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
7c44825c	455
	456	=head1 SEE ALSO
	457
	458	perl(1), Parse::RecDescent, SQL::Translator::Schema.
	459
	460	=cut