release 0.07015
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DBI / Sybase.pm
CommitLineData
fe67d343 1package DBIx::Class::Schema::Loader::DBI::Sybase;
2
3use strict;
4use warnings;
de82711a 5use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common';
942bd5e0 6use mro 'c3';
c4a69b87 7use List::MoreUtils 'any';
8use namespace::clean;
9
10use DBIx::Class::Schema::Loader::Table::Sybase ();
fe67d343 11
5fc335ab 12our $VERSION = '0.07015';
fe67d343 13
14=head1 NAME
15
5163dc4a 16DBIx::Class::Schema::Loader::DBI::Sybase - DBIx::Class::Schema::Loader::DBI
17Sybase ASE Implementation.
fe67d343 18
19=head1 DESCRIPTION
20
5163dc4a 21See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
fe67d343 22
c4a69b87 23This class reblesses into the L<DBIx::Class::Schema::Loader::DBI::Sybase::Microsoft_SQL_Server> class for connections to MSSQL.
bc1cb85e 24
c4a69b87 25=cut
565335e6 26
fe67d343 27sub _rebless {
28 my $self = shift;
29
30 my $dbh = $self->schema->storage->dbh;
31 my $DBMS_VERSION = @{$dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2];
32 if ($DBMS_VERSION =~ /^Microsoft /i) {
b1e43108 33 $DBMS_VERSION =~ s/\s/_/g;
34 my $subclass = "DBIx::Class::Schema::Loader::DBI::Sybase::$DBMS_VERSION";
65f74457 35 if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
36 bless $self, $subclass;
37 $self->_rebless;
fe67d343 38 }
39 }
40}
41
c4a69b87 42sub _system_databases {
43 return (qw/
44 master model sybsystemdb sybsystemprocs tempdb
45 /);
46}
47
48sub _system_tables {
49 return (qw/
50 sysquerymetrics
51 /);
52}
53
54sub _setup {
55 my $self = shift;
56
57 $self->next::method(@_);
58
59 $self->preserve_case(1);
60
61 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
62
63 if (ref $self->db_schema eq 'HASH') {
64 if (keys %{ $self->db_schema } < 2) {
65 my ($db) = keys %{ $self->db_schema };
66
67 $db ||= $current_db;
68
69 if ($db eq '%') {
70 my $owners = $self->db_schema->{$db};
71
72 my $db_names = $self->dbh->selectcol_arrayref(<<'EOF');
73SELECT name
74FROM master.dbo.sysdatabases
75EOF
76
77 my @dbs;
78
79 foreach my $db_name (@$db_names) {
80 push @dbs, $db_name
81 unless any { $_ eq $db_name } $self->_system_databases;
82 }
83
84 $self->db_schema({});
85
86 DB: foreach my $db (@dbs) {
87 if (not ((ref $owners eq 'ARRAY' && $owners->[0] eq '%') || $owners eq '%')) {
88 my @owners;
89
90 foreach my $owner (@$owners) {
91 push @owners, $owner
92 if defined $self->_uid($db, $owner);
93 }
94
95 next DB unless @owners;
96
97 $self->db_schema->{$db} = \@owners;
98 }
99 else {
100 # for post-processing below
101 $self->db_schema->{$db} = '%';
102 }
103 }
104
105 $self->qualify_objects(1);
106 }
107 else {
108 if ($db ne $current_db) {
109 $self->dbh->do("USE [$db]");
110
111 $self->qualify_objects(1);
112 }
113 }
114 }
115 else {
116 $self->qualify_objects(1);
117 }
118 }
119 elsif (ref $self->db_schema eq 'ARRAY' || (not defined $self->db_schema)) {
120 my $owners = $self->db_schema;
121 $owners ||= [ $self->dbh->selectrow_array('SELECT user_name()') ];
122
123 $self->qualify_objects(1) if @$owners > 1;
124
125 $self->db_schema({ $current_db => $owners });
126 }
127
128 foreach my $db (keys %{ $self->db_schema }) {
129 if ($self->db_schema->{$db} eq '%') {
130 my $owners = $self->dbh->selectcol_arrayref(<<"EOF");
131SELECT name
132FROM [$db].dbo.sysusers
133WHERE uid <> gid
134EOF
135 $self->db_schema->{$db} = $owners;
136
137 $self->qualify_objects(1);
138 }
139 }
140}
141
8f65b7e5 142sub _tables_list {
143 my ($self, $opts) = @_;
144
c4a69b87 145 my @tables;
8f65b7e5 146
c4a69b87 147 while (my ($db, $owners) = each %{ $self->db_schema }) {
148 foreach my $owner (@$owners) {
149 my ($uid) = $self->_uid($db, $owner);
8f65b7e5 150
c4a69b87 151 my $table_names = $self->dbh->selectcol_arrayref(<<"EOF");
152SELECT name
153FROM [$db].dbo.sysobjects
154WHERE uid = $uid
155 AND type IN ('U', 'V')
156EOF
157
158 TABLE: foreach my $table_name (@$table_names) {
159 next TABLE if any { $_ eq $table_name } $self->_system_tables;
160
161 push @tables, DBIx::Class::Schema::Loader::Table::Sybase->new(
162 loader => $self,
163 name => $table_name,
164 database => $db,
165 schema => $owner,
166 );
167 }
168 }
169 }
8f65b7e5 170
171 return $self->_filter_tables(\@tables, $opts);
172}
173
c4a69b87 174sub _uid {
175 my ($self, $db, $owner) = @_;
176
177 my ($uid) = $self->dbh->selectrow_array(<<"EOF");
178SELECT uid
179FROM [$db].dbo.sysusers
180WHERE name = @{[ $self->dbh->quote($owner) ]}
181EOF
182
183 return $uid;
184}
185
fe67d343 186sub _table_columns {
187 my ($self, $table) = @_;
188
c4a69b87 189 my $db = $table->database;
190 my $owner = $table->schema;
191
192 my $columns = $self->dbh->selectcol_arrayref(<<"EOF");
9a55cbd2 193SELECT c.name
c4a69b87 194FROM [$db].dbo.syscolumns c
195JOIN [$db].dbo.sysobjects o
196 ON c.id = o.id
197WHERE o.name = @{[ $self->dbh->quote($table->name) ]}
198 AND o.type IN ('U', 'V')
199 AND o.uid = @{[ $self->_uid($db, $owner) ]}
200ORDER BY c.colid ASC
201EOF
fe67d343 202
203 return $columns;
204}
205
206sub _table_pk_info {
207 my ($self, $table) = @_;
208
c4a69b87 209 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
210
211 my $db = $table->database;
212
213 $self->dbh->do("USE [$db]");
214
215 local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
216
217 my $sth = $self->dbh->prepare(<<"EOF");
218sp_pkeys @{[ $self->dbh->quote($table->name) ]},
219 @{[ $self->dbh->quote($table->schema) ]},
220 @{[ $self->dbh->quote($db) ]}
221EOF
fe67d343 222 $sth->execute;
223
224 my @keydata;
225
226 while (my $row = $sth->fetchrow_hashref) {
c9373b79 227 push @keydata, $row->{column_name};
fe67d343 228 }
229
c4a69b87 230 $self->dbh->do("USE [$current_db]");
231
fe67d343 232 return \@keydata;
233}
234
235sub _table_fk_info {
236 my ($self, $table) = @_;
237
c4a69b87 238 my $db = $table->database;
239 my $owner = $table->schema;
240
241 my $sth = $self->dbh->prepare(<<"EOF");
242SELECT sr.reftabid, sd2.name, sr.keycnt,
243 fokey1, fokey2, fokey3, fokey4, fokey5, fokey6, fokey7, fokey8,
244 fokey9, fokey10, fokey11, fokey12, fokey13, fokey14, fokey15, fokey16,
245 refkey1, refkey2, refkey3, refkey4, refkey5, refkey6, refkey7, refkey8,
246 refkey9, refkey10, refkey11, refkey12, refkey13, refkey14, refkey15, refkey16
247FROM [$db].dbo.sysreferences sr
248JOIN [$db].dbo.sysobjects so1
249 ON sr.tableid = so1.id
250JOIN [$db].dbo.sysusers su1
251 ON so1.uid = su1.uid
252JOIN master.dbo.sysdatabases sd2
253 ON sr.pmrydbid = sd2.dbid
254WHERE so1.name = @{[ $self->dbh->quote($table->name) ]}
255 AND su1.name = @{[ $self->dbh->quote($table->schema) ]}
256EOF
fe67d343 257 $sth->execute;
258
c4a69b87 259 my @rels;
0852b7b8 260
c4a69b87 261 REL: while (my @rel = $sth->fetchrow_array) {
262 my ($remote_tab_id, $remote_db, $key_cnt) = splice @rel, 0, 3;
dc379dc6 263
c4a69b87 264 my ($remote_tab_owner, $remote_tab_name) =
265 $self->dbh->selectrow_array(<<"EOF");
266SELECT su.name, so.name
267FROM [$remote_db].dbo.sysusers su
268JOIN [$remote_db].dbo.sysobjects so
269 ON su.uid = so.uid
270WHERE so.id = $remote_tab_id
271EOF
dc379dc6 272
c4a69b87 273 next REL
274 unless any { $_ eq $remote_tab_owner }
275 @{ $self->db_schema->{$remote_db} || [] };
dc379dc6 276
c4a69b87 277 my @local_col_ids = splice @rel, 0, 16;
278 my @remote_col_ids = splice @rel, 0, 16;
0852b7b8 279
c4a69b87 280 @local_col_ids = splice @local_col_ids, 0, $key_cnt;
281 @remote_col_ids = splice @remote_col_ids, 0, $key_cnt;
0852b7b8 282
c4a69b87 283 my $remote_table = DBIx::Class::Schema::Loader::Table::Sybase->new(
284 loader => $self,
285 name => $remote_tab_name,
286 database => $remote_db,
287 schema => $remote_tab_owner,
288 );
0852b7b8 289
c4a69b87 290 my $all_local_cols = $self->_table_columns($table);
291 my $all_remote_cols = $self->_table_columns($remote_table);
0852b7b8 292
c4a69b87 293 my @local_cols = map $all_local_cols->[$_-1], @local_col_ids;
294 my @remote_cols = map $all_remote_cols->[$_-1], @remote_col_ids;
dc379dc6 295
c4a69b87 296 next REL if (any { not defined $_ } @local_cols)
297 || (any { not defined $_ } @remote_cols);
dc379dc6 298
299 push @rels, {
300 local_columns => \@local_cols,
dc379dc6 301 remote_table => $remote_table,
c4a69b87 302 remote_columns => \@remote_cols,
dc379dc6 303 };
c4a69b87 304 };
0852b7b8 305
306 return \@rels;
307}
308
fe67d343 309sub _table_uniq_info {
310 my ($self, $table) = @_;
311
c4a69b87 312 my $db = $table->database;
313 my $owner = $table->schema;
314 my $uid = $self->_uid($db, $owner);
315
316 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
317
318 $self->dbh->do("USE [$db]");
319
320 my $sth = $self->dbh->prepare(<<"EOF");
321SELECT si.name, si.indid, si.keycnt
322FROM [$db].dbo.sysindexes si
323JOIN [$db].dbo.sysobjects so
324 ON si.id = so.id
325WHERE so.name = @{[ $self->dbh->quote($table->name) ]}
326 AND so.uid = $uid
327 AND si.indid > 0
328 AND si.status & 2048 <> 2048
329 AND si.status2 & 2 = 2
330EOF
331 $sth->execute;
0852b7b8 332
c4a69b87 333 my %uniqs;
fe67d343 334
c4a69b87 335 while (my ($ind_name, $ind_id, $key_cnt) = $sth->fetchrow_array) {
336 COLS: foreach my $col_idx (1 .. ($key_cnt+1)) {
337 my ($next_col) = $self->dbh->selectrow_array(<<"EOF");
338SELECT index_col(
339 @{[ $self->dbh->quote($table->name) ]},
340 $ind_id, $col_idx, $uid
341)
342EOF
343 last COLS unless defined $next_col;
344
345 push @{ $uniqs{$ind_name} }, $next_col;
fe67d343 346 }
347 }
348
c4a69b87 349 my @uniqs = map { [ $_ => $uniqs{$_} ] } keys %uniqs;
350
351 $self->dbh->do("USE [$current_db]");
352
fe67d343 353 return \@uniqs;
354}
355
db4d62ad 356sub _columns_info_for {
357 my $self = shift;
358 my ($table) = @_;
359 my $result = $self->next::method(@_);
360
c4a69b87 361 my $db = $table->database;
362 my $owner = $table->schema;
363 my $uid = $self->_uid($db, $owner);
364
365 local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
366 my $sth = $self->dbh->prepare(<<"EOF");
5163dc4a 367SELECT c.name name, bt.name base_type, ut.name user_type, cm.text deflt, c.prec prec, c.scale scale, c.length len
c4a69b87 368FROM [$db].dbo.syscolumns c
369JOIN [$db].dbo.sysobjects o ON c.id = o.id
370LEFT JOIN [$db].dbo.systypes bt ON c.type = bt.type
371LEFT JOIN [$db].dbo.systypes ut ON c.usertype = ut.usertype
372LEFT JOIN [$db].dbo.syscomments cm
2fb9a4b3 373 ON cm.id = CASE WHEN c.cdefault = 0 THEN c.computedcol ELSE c.cdefault END
c4a69b87 374WHERE o.name = @{[ $self->dbh->quote($table) ]}
375 AND o.uid = $uid
376 AND o.type IN ('U', 'V')
377EOF
db4d62ad 378 $sth->execute;
2fb9a4b3 379 my $info = $sth->fetchall_hashref('name');
db4d62ad 380
2fb9a4b3 381 while (my ($col, $res) = each %$result) {
5163dc4a 382 my $data_type = $res->{data_type} = $info->{$col}{user_type} || $info->{$col}{base_type};
c4a69b87 383
384 # check if it's an IDENTITY column
385 my $sth = $self->dbh->prepare(<<"EOF");
386SELECT name
387FROM [$db].dbo.syscolumns
388WHERE id = (
389 SELECT id
390 FROM [$db].dbo.sysobjects
391 WHERE name = @{[ $self->dbh->quote($table->name) ]}
392 AND uid = $uid
393)
394 AND (status & 0x80) = 0x80
395 AND name = @{[ $self->dbh->quote($col) ]}
396EOF
397 $sth->execute;
398
399 if ($sth->fetchrow_array) {
400 $res->{is_auto_increment} = 1;
401 }
41968729 402
403 if ($data_type && $data_type =~ /^timestamp\z/i) {
404 $res->{inflate_datetime} = 0;
405 }
2fb9a4b3 406
407 if (my $default = $info->{$col}{deflt}) {
408 if ($default =~ /^AS \s+ (\S+)/ix) {
409 my $function = $1;
410 $res->{default_value} = \$function;
0faae4b8 411
412 if ($function =~ /^getdate\b/) {
413 $res->{inflate_datetime} = 1;
414 }
5163dc4a 415
416 delete $res->{size};
417 $res->{data_type} = undef;
2fb9a4b3 418 }
419 elsif ($default =~ /^DEFAULT \s+ (\S+)/ix) {
41968729 420 my ($constant_default) = $1 =~ /^['"\[\]]?(.*?)['"\[\]]?\z/;
2fb9a4b3 421 $res->{default_value} = $constant_default;
422 }
423 }
6ecee584 424
6ecee584 425 if (my $data_type = $res->{data_type}) {
5163dc4a 426 if ($data_type eq 'int') {
427 $data_type = $res->{data_type} = 'integer';
428 }
429 elsif ($data_type eq 'decimal') {
430 $data_type = $res->{data_type} = 'numeric';
431 }
432
433 if ($data_type =~ /^(?:text|unitext|image|bigint|integer|smallint|tinyint|real|double|double precision|float|date|time|datetime|smalldatetime|money|smallmoney|timestamp|bit)\z/i) {
6ecee584 434 delete $res->{size};
435 }
5163dc4a 436 elsif ($data_type eq 'numeric') {
437 my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/};
438
439 if ($prec == 18 && $scale == 0) {
440 delete $res->{size};
441 }
442 else {
443 $res->{size} = [ $prec, $scale ];
444 }
6ecee584 445 }
c4a69b87 446 elsif ($data_type =~ /char/) {
447 $res->{size} = $info->{$col}{len};
448
449 if ($data_type =~ /^(?:unichar|univarchar)\z/i) {
450 $res->{size} /= 2;
451 }
6ecee584 452 }
453 }
5163dc4a 454
455 if ($data_type eq 'float') {
456 $res->{data_type} = $info->{$col}{len} <= 4 ? 'real' : 'double precision';
457 }
db4d62ad 458 }
459
460 return $result;
461}
462
fe67d343 463=head1 SEE ALSO
464
5163dc4a 465L<DBIx::Class::Schema::Loader::DBI::Sybase::Common>,
fe67d343 466L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
467L<DBIx::Class::Schema::Loader::DBI>
468
469=head1 AUTHOR
470
9cc8e7e1 471See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
fe67d343 472
be80bba7 473=head1 LICENSE
0852b7b8 474
be80bba7 475This library is free software; you can redistribute it and/or modify it under
476the same terms as Perl itself.
0852b7b8 477
fe67d343 478=cut
479
4801;
db9c411a 481# vim:et sts=4 sw=4 tw=0: