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

package SQL::Translator::Parser::Sybase;

# -------------------------------------------------------------------
# $Id: Sybase.pm,v 1.4 2003-01-27 17:04:46 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::Sybase - parser for Sybase

=head1 SYNOPSIS

  use SQL::Translator::Parser::Sybase;

=head1 DESCRIPTION

Parses the output of "dbschema.pl," a Perl script freely available from
www.midsomer.org.

=cut

my $grammar = q{

    { our ( %tables ) }

    file         : statement(s) { \%tables }
#        { print "statements: ", join("\n", @{$item[1]}), "\n" }
#                   | <error>

    statement    : create
                   | junk
#        { 
#            print "statement: ", join("\n", @{$item[1]}), "\n";
#            $return = @{$item[1]};
#            print "statement: '", $item[1], "'\n";
#            $return = $item[1];
#        }
                   | <error>

    junk         : comment 
                   | use
                   | setuser
                   | if
                   | print
                   | else
                   | begin
                   | end
                   | grant
                   | exec
                   | GO

    GO           : /go/
#        { print "GO: ", $item[1], "\n" }

    use          : /use/i /.*/
#        { print "USE: ", $item[2], "\n" }

    setuser      : /setuser/i /.*/
#        { print "SETUSER: ", $item[2], "\n" }

    if           : /if/i /.*/
#        { print "IF: ", $item[2], "\n" }

    print        : /\s*/ /print/i /.*/
#       { print "PRINT: ", $item[3], "\n" }

    else        : /else/i /.*/
#        { print "ELSE: ", $item[2], "\n" }

    begin       : /begin/i
#        { print "BEGIN\n" }

    end         : /end/i
#        { print "END\n" }

    grant       : /grant/i /.*/
#        { print "GRANT: ", $item[2], "\n" }

    exec        : /exec/i /.*/
#        { print "EXEC: ", $item[2], "\n" }

    comment      : /^\s*\/\*.*\*\//m
#        { print "COMMENT: ", $item[-1], "\n" }

    create       : create_table table_name '(' field(s /,/) ')' lock(?)
                { 
#                    print "TABLE $item[2]: ", 
#                        join(', ', map{$_->{'name'}}@{$item[4]}), "\n";
                    my $i = 0;
                    for my $line ( @{ $item[4] } ) {
                        if ( $line->{'type'} eq 'field' ) {
                            my $field_name = $line->{'name'};
                            $tables{ $item{'table_name'} }
                                {'fields'}{$field_name} = 
                                { %$line, order => $i };
                            $i++;
                    
                            if ( $line->{'is_primary_key'} ) {
                                push
                                @{ $tables{ $item{'table_name'} }{'indices'} },
                                {
                                    type   => 'primary_key',
                                    fields => [ $field_name ],
                                };
                            }
                        }
                        else {
                            push @{ $tables{ $item{'table_name'} }{'indices'} },
                                $line;
                        }
                        $tables{ $item{'table_name'} }{'type'} = 
                            $item{'table_type'}[0];
                    }
                }
                   | <error>

    blank        : /\s*/

    field        : field_name data_type null(?) 
                   { 
                        $return = { 
                            type           => 'field',
                            name           => $item{'field_name'}, 
                            data_type      => $item{'data_type'}{'type'},
                            size           => $item{'data_type'}{'size'},
                            null           => $item{'null'}[0], 
#                            default        => $item{'default_val'}[0], 
#                            is_auto_inc    => $item{'auto_inc'}[0], 
#                            is_primary_key => $item{'primary_key'}[0], 
                       } 
                   }
                | <error>

    index        : primary_key_index
                   | unique_index
                   | normal_index

    table_name   : WORD '.' WORD
        { $return = $item[3] }

    field_name   : WORD

    index_name   : WORD

    data_type    : WORD field_size(?) 
        { 
            $return = { 
                type => $item[1], 
                size => $item[2][0]
            } 
        }

    lock         : /lock/i /datarows/i

    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

    null         : /not/i /null/i
        { $return = 0 }
                   | /null/i
        { $return = 1 }

    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(?) '(' field_name(s /,/) ')'
        { 
            $return = { 
                name   => $item{'index_name'}[0],
                type   => 'normal',
                fields => $item[4],
            } 
        }

    unique_index      : /unique/i key index_name(?) '(' field_name(s /,/) ')'
        { 
            $return = { 
                name   => $item{'index_name'}[0],
                type   => 'unique',
                fields => $item[5],
            } 
        }

    key          : /key/i 
                   | /index/i

    table_type   : /TYPE=/i /\w+/ { $item[2] }

    WORD         : /[\w#]+/

    DIGITS       : /\d+/

    COMMA        : ','

};

1;

#-----------------------------------------------------
# Every hero becomes a bore at last.
# Ralph Waldo Emerson
#-----------------------------------------------------

=pod

=head1 AUTHOR

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

=head1 SEE ALSO

perl(1).

=cut
Commit	Line	Data
16dc9970	1	package SQL::Translator::Parser::Sybase;
16dc9970	2
d529894e	3	# -------------------------------------------------------------------
abfa405a	4	# $Id: Sybase.pm,v 1.4 2003-01-27 17:04:46 dlc Exp $
d529894e	5	# -------------------------------------------------------------------
abfa405a	6	# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
	7	# darren chamberlain <darren@cpan.org>,
	8	# Chris Mungall <cjm@fruitfly.org>
16dc9970	9	#
d529894e	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	# -------------------------------------------------------------------
	24
	25	=head1 NAME
	26
	27	SQL::Translator::Parser::Sybase - parser for Sybase
	28
	29	=head1 SYNOPSIS
	30
	31	use SQL::Translator::Parser::Sybase;
	32
	33	=head1 DESCRIPTION
	34
	35	Parses the output of "dbschema.pl," a Perl script freely available from
	36	www.midsomer.org.
	37
	38	=cut
16dc9970	39
	40	my $grammar = q{
	41
	42	{ our ( %tables ) }
	43
	44	file : statement(s) { \%tables }
	45	# { print "statements: ", join("\n", @{$item[1]}), "\n" }
	46	# \| <error>
	47
	48	statement : create
	49	\| junk
	50	# {
	51	# print "statement: ", join("\n", @{$item[1]}), "\n";
	52	# $return = @{$item[1]};
	53	# print "statement: '", $item[1], "'\n";
	54	# $return = $item[1];
	55	# }
	56	\| <error>
	57
	58	junk : comment
	59	\| use
	60	\| setuser
	61	\| if
	62	\| print
	63	\| else
	64	\| begin
	65	\| end
	66	\| grant
	67	\| exec
	68	\| GO
	69
	70	GO : /go/
	71	# { print "GO: ", $item[1], "\n" }
	72
	73	use : /use/i /.*/
	74	# { print "USE: ", $item[2], "\n" }
	75
	76	setuser : /setuser/i /.*/
	77	# { print "SETUSER: ", $item[2], "\n" }
	78
	79	if : /if/i /.*/
	80	# { print "IF: ", $item[2], "\n" }
	81
	82	print : /\s/ /print/i /./
	83	# { print "PRINT: ", $item[3], "\n" }
	84
	85	else : /else/i /.*/
	86	# { print "ELSE: ", $item[2], "\n" }
	87
	88	begin : /begin/i
	89	# { print "BEGIN\n" }
	90
	91	end : /end/i
	92	# { print "END\n" }
	93
	94	grant : /grant/i /.*/
	95	# { print "GRANT: ", $item[2], "\n" }
	96
	97	exec : /exec/i /.*/
	98	# { print "EXEC: ", $item[2], "\n" }
	99
	100	comment : /^\s\/\.\\//m
	101	# { print "COMMENT: ", $item[-1], "\n" }
	102
103	create : create_table table_name '(' field(s /,/) ')' lock(?)
104	{
105	# print "TABLE $item[2]: ",
106	# join(', ', map{$_->{'name'}}@{$item[4]}), "\n";
107	my $i = 0;
108	for my $line ( @{ $item[4] } ) {
109	if ( $line->{'type'} eq 'field' ) {
110	my $field_name = $line->{'name'};
111	$tables{ $item{'table_name'} }
112	{'fields'}{$field_name} =
113	{ %$line, order => $i };
114	$i++;
115
116	if ( $line->{'is_primary_key'} ) {
117	push
49e1eb70	118	@{ $tables{ $item{'table_name'} }{'indices'} },
16dc9970	119	{
	120	type => 'primary_key',
	121	fields => [ $field_name ],
	122	};
	123	}
	124	}
	125	else {
49e1eb70	126	push @{ $tables{ $item{'table_name'} }{'indices'} },
16dc9970	127	$line;
	128	}
	129	$tables{ $item{'table_name'} }{'type'} =
	130	$item{'table_type'}[0];
	131	}
	132	}
	133	\| <error>
	134
	135	blank : /\s*/
	136
	137	field : field_name data_type null(?)
	138	{
	139	$return = {
	140	type => 'field',
	141	name => $item{'field_name'},
	142	data_type => $item{'data_type'}{'type'},
	143	size => $item{'data_type'}{'size'},
	144	null => $item{'null'}[0],
	145	# default => $item{'default_val'}[0],
	146	# is_auto_inc => $item{'auto_inc'}[0],
	147	# is_primary_key => $item{'primary_key'}[0],
	148	}
	149	}
	150	\| <error>
	151
	152	index : primary_key_index
	153	\| unique_index
	154	\| normal_index
	155
	156	table_name : WORD '.' WORD
	157	{ $return = $item[3] }
	158
	159	field_name : WORD
	160
	161	index_name : WORD
	162
	163	data_type : WORD field_size(?)
	164	{
	165	$return = {
	166	type => $item[1],
	167	size => $item[2][0]
	168	}
	169	}
	170
	171	lock : /lock/i /datarows/i
	172
	173	field_type : WORD
	174
	175	field_size : '(' num_range ')' { $item{'num_range'} }
	176
	177	num_range : DIGITS ',' DIGITS
	178	{ $return = $item[1].','.$item[3] }
	179	\| DIGITS
	180	{ $return = $item[1] }
	181
	182
	183	create_table : /create/i /table/i
	184
	185	null : /not/i /null/i
	186	{ $return = 0 }
	187	\| /null/i
	188	{ $return = 1 }
	189
	190	default_val : /default/i /(?:')?[\w\d.-]*(?:')?/ { $item[2]=~s/'//g; $return=$item[2] }
191
192	auto_inc : /auto_increment/i { 1 }
193
194	primary_key : /primary/i /key/i { 1 }
195
196	primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
197	{
198	$return = {
199	name => $item{'index_name'}[0],
200	type => 'primary_key',
201	fields => $item[4],
202	}
203	}
204
205	normal_index : key index_name(?) '(' field_name(s /,/) ')'
206	{
207	$return = {
208	name => $item{'index_name'}[0],
209	type => 'normal',
210	fields => $item[4],
211	}
212	}
213
214	unique_index : /unique/i key index_name(?) '(' field_name(s /,/) ')'
215	{
216	$return = {
217	name => $item{'index_name'}[0],
218	type => 'unique',
219	fields => $item[5],
220	}
221	}
222
223	key : /key/i
224	\| /index/i
225
226	table_type : /TYPE=/i /\w+/ { $item[2] }
227
228	WORD : /[\w#]+/
229
230	DIGITS : /\d+/
231
232	COMMA : ','
233
234	};
235
236	1;
237
238	#-----------------------------------------------------
239	# Every hero becomes a bore at last.
240	# Ralph Waldo Emerson
241	#-----------------------------------------------------
242
d529894e	243	=pod
16dc9970	244
	245	=head1 AUTHOR
	246
d529894e	247	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
16dc9970	248
	249	=head1 SEE ALSO
	250
	251	perl(1).
	252
	253	=cut