Added sorting of tables, other cosmetic changes.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / Sybase.pm
1 package SQL::Translator::Parser::Sybase;
2
3 # -------------------------------------------------------------------
4 # $Id: Sybase.pm,v 1.4 2003-01-27 17:04:46 dlc Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7 #                    darren chamberlain <darren@cpan.org>,
8 #                    Chris Mungall <cjm@fruitfly.org>
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 # -------------------------------------------------------------------
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
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
118                                 @{ $tables{ $item{'table_name'} }{'indices'} },
119                                 {
120                                     type   => 'primary_key',
121                                     fields => [ $field_name ],
122                                 };
123                             }
124                         }
125                         else {
126                             push @{ $tables{ $item{'table_name'} }{'indices'} },
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
243 =pod
244
245 =head1 AUTHOR
246
247 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
248
249 =head1 SEE ALSO
250
251 perl(1).
252
253 =cut