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

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

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