Commit | Line | Data |
86ee0658 |
1 | package SQL::Translator::Parser::DBI::Sybase; |
2 | |
587a99b0 |
3 | # ------------------------------------------------------------------- |
546dad3b |
4 | # $Id: Sybase.pm,v 1.6 2004-07-30 16:13:52 phrrngtn Exp $ |
587a99b0 |
5 | # ------------------------------------------------------------------- |
90075866 |
6 | # Copyright (C) 2002-4 SQLFairy Authors |
587a99b0 |
7 | # |
8 | # This program is free software; you can redistribute it and/or |
9 | # modify it under the terms of the GNU General Public License as |
10 | # published by the Free Software Foundation; version 2. |
11 | # |
12 | # This program is distributed in the hope that it will be useful, but |
13 | # WITHOUT ANY WARRANTY; without even the implied warranty of |
14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 | # General Public License for more details. |
16 | # |
17 | # You should have received a copy of the GNU General Public License |
18 | # along with this program; if not, write to the Free Software |
19 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
20 | # 02111-1307 USA |
21 | # ------------------------------------------------------------------- |
86ee0658 |
22 | |
23 | =head1 NAME |
24 | |
25 | SQL::Translator::Parser::DBI::Sybase - parser for DBD::Sybase |
26 | |
27 | =head1 SYNOPSIS |
28 | |
29 | See SQL::Translator::Parser::DBI. |
30 | |
31 | =head1 DESCRIPTION |
32 | |
33 | Uses DBI Catalog Methods. |
34 | |
35 | =cut |
36 | |
37 | use strict; |
38 | use DBI; |
39 | use SQL::Translator::Schema; |
40 | use Data::Dumper; |
41 | |
42 | use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; |
546dad3b |
43 | $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; |
86ee0658 |
44 | $DEBUG = 0 unless defined $DEBUG; |
45 | |
46 | no strict 'refs'; |
47 | |
48 | # ------------------------------------------------------------------- |
49 | sub parse { |
50 | my ( $tr, $dbh ) = @_; |
51 | |
52 | if ($dbh->{FetchHashKeyName} ne 'NAME_uc') { |
53 | warn "setting dbh attribute {FetchHashKeyName} to NAME_uc"; |
54 | $dbh->{FetchHashKeyName} = 'NAME_uc'; |
55 | } |
56 | |
57 | if ($dbh->{ChopBlanks} != 1) { |
58 | warn "setting dbh attribute {ChopBlanks} to 1"; |
59 | $dbh->{ChopBlanks} = 1; |
60 | } |
61 | |
62 | my $schema = $tr->schema; |
63 | |
64 | my ($sth, @tables, $columns); |
65 | my $stuff; |
66 | |
67 | ### Columns |
68 | |
69 | # it is much quicker to slurp back everything all at once rather |
70 | # than make repeated calls |
71 | |
546dad3b |
72 | $sth = $dbh->column_info(undef, undef, undef, undef); |
86ee0658 |
73 | |
74 | |
75 | foreach my $c (@{$sth->fetchall_arrayref({})}) { |
76 | $columns |
77 | ->{$c->{TABLE_CAT}} |
78 | ->{$c->{TABLE_SCHEM}} |
79 | ->{$c->{TABLE_NAME}} |
80 | ->{columns} |
81 | ->{$c->{COLUMN_NAME}}= $c; |
82 | } |
83 | |
84 | ### Tables and views |
85 | |
86 | # Get a list of the tables and views. |
87 | $sth = $dbh->table_info(); |
88 | @tables = @{$sth->fetchall_arrayref({})}; |
89 | |
90 | my $h = $dbh->selectall_arrayref(q{ |
91 | SELECT o.name, colid,colid2,c.text |
92 | FROM syscomments c |
93 | JOIN sysobjects o |
94 | ON c.id = o.id |
95 | WHERE o.type ='V' |
96 | ORDER BY o.name, |
97 | c.colid, |
98 | c.colid2 |
99 | } |
100 | ); |
101 | |
102 | # View text |
103 | # I had always thought there was something 'hard' about |
e36f4eac |
104 | # reconstructing text from syscomments .. |
86ee0658 |
105 | # this seems to work fine and is certainly not complicated! |
106 | |
107 | foreach (@{$h}) { |
108 | $stuff->{view}->{$_->[0]}->{text} .= $_->[3]; |
109 | } |
110 | |
111 | #### objects with indexes. |
112 | map { |
113 | $stuff->{indexes}->{$_->[0]}++ |
114 | if defined; |
1eb8ea88 |
115 | } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id) AS name |
116 | FROM sysindexes |
117 | WHERE indid > 0")}; |
86ee0658 |
118 | |
119 | ## slurp objects |
120 | map { |
121 | $stuff->{$_->[1]}->{$_->[0]} = $_; |
1eb8ea88 |
122 | } @{$dbh->selectall_arrayref("SELECT name,type, id FROM sysobjects")}; |
86ee0658 |
123 | |
124 | |
125 | ### Procedures |
1eb8ea88 |
126 | |
127 | # This gets legitimate procedures by used the 'supported' API: sp_stored_procedures |
128 | map { |
129 | my $n = $_->{PROCEDURE_NAME}; |
130 | $n =~ s/;\d+$//; # Ignore versions for now |
131 | $_->{name} = $n; |
132 | $stuff->{procedures}->{$n} = $_; |
133 | } values %{$dbh->selectall_hashref("sp_stored_procedures", 'PROCEDURE_NAME')}; |
134 | |
135 | |
136 | # And this blasts in the text of 'legit' stored procedures. Do |
137 | # this rather than calling sp_helptext in a loop. |
138 | |
139 | $h = $dbh->selectall_arrayref(q{ |
140 | SELECT o.name, colid,colid2,c.text |
141 | FROM syscomments c |
142 | JOIN sysobjects o |
143 | ON c.id = o.id |
144 | WHERE o.type ='P' |
145 | ORDER BY o.name, |
146 | c.colid, |
147 | c.colid2 |
148 | } |
149 | ); |
150 | |
151 | foreach (@{$h}) { |
152 | $stuff->{procedures}->{$_->[0]}->{text} .= $_->[3] |
153 | if (defined($stuff->{procedures}->{$_->[0]})); |
154 | } |
155 | |
86ee0658 |
156 | ### Defaults |
157 | ### Rules |
158 | ### Bind Defaults |
159 | ### Bind Rules |
160 | |
161 | ### Triggers |
1eb8ea88 |
162 | # Since the 'target' of the trigger is defined in the text, we will |
163 | # just create them independently for now rather than associating them |
164 | # with a table. |
165 | |
166 | $h = $dbh->selectall_arrayref(q{ |
167 | SELECT o.name, colid,colid2,c.text |
168 | FROM syscomments c |
169 | JOIN sysobjects o |
170 | ON c.id = o.id |
171 | JOIN sysobjects o1 |
172 | ON (o.id = o1.instrig OR o.id = o1.deltrig or o.id = o1.updtrig) |
173 | WHERE o.type ='TR' |
174 | ORDER BY o.name, |
175 | c.colid, |
176 | c.colid2 |
177 | } |
178 | ); |
179 | foreach (@{$h}) { |
180 | $stuff->{triggers}->{$_->[0]}->{text} .= $_->[3]; |
181 | } |
86ee0658 |
182 | |
183 | ### References |
184 | ### Keys |
185 | |
186 | ### Types |
1eb8ea88 |
187 | # Not sure what to do with these? |
86ee0658 |
188 | $stuff->{type_info_all} = $dbh->type_info_all; |
189 | |
190 | ### Tables |
191 | # According to the DBI docs, these can be |
192 | |
193 | # "TABLE" |
194 | # "VIEW" |
195 | # "SYSTEM TABLE" |
196 | # "GLOBAL TEMPORARY", |
197 | # "LOCAL TEMPORARY" |
198 | # "ALIAS" |
199 | # "SYNONYM" |
200 | |
201 | foreach my $table_info (@tables) { |
202 | next |
203 | unless (defined($table_info->{TABLE_TYPE})); |
204 | |
205 | if ($table_info->{TABLE_TYPE} =~ /TABLE/) { |
206 | my $table = $schema->add_table( |
207 | name => |
208 | $table_info->{TABLE_NAME}, |
209 | type => |
210 | $table_info->{TABLE_TYPE}, |
211 | ) || die $schema->error; |
212 | |
213 | # find the associated columns |
214 | |
215 | my $cols = |
216 | $columns->{$table_info->{TABLE_QUALIFIER}} |
217 | ->{$table_info->{TABLE_OWNER}} |
218 | ->{$table_info->{TABLE_NAME}} |
219 | ->{columns}; |
220 | |
221 | foreach my $c (values %{$cols}) { |
1eb8ea88 |
222 | my $f = $table->add_field( |
223 | name => $c->{COLUMN_NAME}, |
224 | data_type => $c->{TYPE_NAME}, |
225 | order => $c->{ORDINAL_POSITION}, |
226 | size => $c->{COLUMN_SIZE}, |
86ee0658 |
227 | ) || die $table->error; |
1eb8ea88 |
228 | |
86ee0658 |
229 | $f->is_nullable(1) |
230 | if ($c->{NULLABLE} == 1); |
231 | } |
232 | |
233 | # add in primary key |
234 | my $h = $dbh->selectall_hashref("sp_pkeys |
235 | $table_info->{TABLE_NAME}", 'COLUMN_NAME'); |
236 | if (scalar keys %{$h} > 1) { |
237 | my @c = map { |
238 | $_->{COLUMN_NAME} |
239 | } sort { |
240 | $a->{KEY_SEQ} <=> $b->{KEY_SEQ} |
241 | } values %{$h}; |
242 | |
243 | $table->primary_key(@c) |
244 | if (scalar @c); |
245 | } |
246 | |
247 | # add in any indexes ... how do we tell if the index has |
248 | # already been created as part of a primary key or other |
249 | # constraint? |
250 | |
1eb8ea88 |
251 | if (defined($stuff->{indexes}->{$table_info->{TABLE_NAME}})){ |
86ee0658 |
252 | my $h = $dbh->selectall_hashref("sp_helpindex |
253 | $table_info->{TABLE_NAME}", 'INDEX_NAME'); |
254 | foreach (values %{$h}) { |
255 | my $fields = $_->{'INDEX_KEYS'}; |
256 | $fields =~ s/\s*//g; |
257 | my $i = $table->add_index( |
258 | name => |
259 | $_->{INDEX_NAME}, |
260 | fields => $fields, |
261 | ); |
262 | if ($_->{'INDEX_DESCRIPTION'} =~ /unique/i) { |
263 | $i->type('unique'); |
264 | |
265 | # we could make this a primary key if there |
266 | # isn't already one defined and if there |
267 | # aren't any nullable columns in thisindex. |
268 | |
269 | if (!defined($table->primary_key())) { |
270 | $table->primary_key($fields) |
271 | unless grep { |
272 | $table->get_field($_)->is_nullable() |
273 | } split(/,\s*/, $fields); |
274 | } |
275 | } |
276 | } |
277 | } |
278 | } elsif ($table_info->{TABLE_TYPE} eq 'VIEW') { |
279 | my $view = $schema->add_view( |
280 | name => |
281 | $table_info->{TABLE_NAME}, |
282 | ); |
283 | |
1eb8ea88 |
284 | |
86ee0658 |
285 | my $cols = |
286 | $columns->{$table_info->{TABLE_QUALIFIER}} |
287 | ->{$table_info->{TABLE_OWNER}} |
288 | ->{$table_info->{TABLE_NAME}} |
289 | ->{columns}; |
290 | |
291 | $view->fields(map { |
292 | $_->{COLUMN_NAME} |
293 | } sort { |
294 | $a->{ORDINAL_POSITION} <=> $b->{ORDINAL_POSITION} |
295 | } values %{$cols} |
296 | ); |
297 | |
1eb8ea88 |
298 | $view->sql($stuff->{view}->{$table_info->{TABLE_NAME}}->{text}) |
299 | if (defined($stuff->{view}->{$table_info->{TABLE_NAME}}->{text})); |
86ee0658 |
300 | } |
301 | } |
1eb8ea88 |
302 | |
303 | foreach my $p (values %{$stuff->{procedures}}) { |
304 | my $proc = $schema->add_procedure( |
305 | name => $p->{name}, |
306 | owner => $p->{PROCEDURE_OWNER}, |
307 | comments => $p->{REMARKS}, |
308 | sql => $p->{text}, |
309 | ); |
310 | |
311 | } |
587a99b0 |
312 | |
86ee0658 |
313 | ### Permissions |
314 | ### Groups |
315 | ### Users |
316 | ### Aliases |
317 | ### Logins |
587a99b0 |
318 | return 1; |
86ee0658 |
319 | } |
320 | |
321 | 1; |
322 | |
587a99b0 |
323 | # ------------------------------------------------------------------- |
324 | |
86ee0658 |
325 | =pod |
326 | |
327 | =head1 AUTHOR |
328 | |
587a99b0 |
329 | Paul Harrington E<lt>harringp@deshaw.comE<gt>. |
86ee0658 |
330 | |
331 | =head1 SEE ALSO |
332 | |
333 | DBI, DBD::Sybase, SQL::Translator::Schema. |
334 | |
335 | =cut |