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