1 package DBIx::Class::Schema::Loader::DBI::Sybase;
5 use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common';
7 use List::MoreUtils 'any';
10 use DBIx::Class::Schema::Loader::Table::Sybase ();
12 our $VERSION = '0.07022';
16 DBIx::Class::Schema::Loader::DBI::Sybase - DBIx::Class::Schema::Loader::DBI
17 Sybase ASE Implementation.
21 See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
23 This class reblesses into the L<DBIx::Class::Schema::Loader::DBI::Sybase::Microsoft_SQL_Server> class for connections to MSSQL.
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) {
33 $DBMS_VERSION =~ s/\s/_/g;
34 my $subclass = "DBIx::Class::Schema::Loader::DBI::Sybase::$DBMS_VERSION";
35 if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
36 bless $self, $subclass;
42 sub _system_databases {
44 master model sybsystemdb sybsystemprocs tempdb
57 $self->next::method(@_);
59 $self->preserve_case(1);
61 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
63 if (ref $self->db_schema eq 'HASH') {
64 if (keys %{ $self->db_schema } < 2) {
65 my ($db) = keys %{ $self->db_schema };
70 my $owners = $self->db_schema->{$db};
72 my $db_names = $self->dbh->selectcol_arrayref(<<'EOF');
74 FROM master.dbo.sysdatabases
79 foreach my $db_name (@$db_names) {
81 unless any { $_ eq $db_name } $self->_system_databases;
86 DB: foreach my $db (@dbs) {
87 if (not ((ref $owners eq 'ARRAY' && $owners->[0] eq '%') || $owners eq '%')) {
90 foreach my $owner (@$owners) {
92 if defined $self->_uid($db, $owner);
95 next DB unless @owners;
97 $self->db_schema->{$db} = \@owners;
100 # for post-processing below
101 $self->db_schema->{$db} = '%';
105 $self->qualify_objects(1);
108 if ($db ne $current_db) {
109 $self->dbh->do("USE [$db]");
111 $self->qualify_objects(1);
116 $self->qualify_objects(1);
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()') ];
123 $self->qualify_objects(1) if @$owners > 1;
125 $self->db_schema({ $current_db => $owners });
128 foreach my $db (keys %{ $self->db_schema }) {
129 if ($self->db_schema->{$db} eq '%') {
130 my $owners = $self->dbh->selectcol_arrayref(<<"EOF");
132 FROM [$db].dbo.sysusers
135 $self->db_schema->{$db} = $owners;
137 $self->qualify_objects(1);
143 my ($self, $opts) = @_;
147 while (my ($db, $owners) = each %{ $self->db_schema }) {
148 foreach my $owner (@$owners) {
149 my ($uid) = $self->_uid($db, $owner);
151 my $table_names = $self->dbh->selectcol_arrayref(<<"EOF");
153 FROM [$db].dbo.sysobjects
155 AND type IN ('U', 'V')
158 TABLE: foreach my $table_name (@$table_names) {
159 next TABLE if any { $_ eq $table_name } $self->_system_tables;
161 push @tables, DBIx::Class::Schema::Loader::Table::Sybase->new(
171 return $self->_filter_tables(\@tables, $opts);
175 my ($self, $db, $owner) = @_;
177 my ($uid) = $self->dbh->selectrow_array(<<"EOF");
179 FROM [$db].dbo.sysusers
180 WHERE name = @{[ $self->dbh->quote($owner) ]}
187 my ($self, $table) = @_;
189 my $db = $table->database;
190 my $owner = $table->schema;
192 my $columns = $self->dbh->selectcol_arrayref(<<"EOF");
194 FROM [$db].dbo.syscolumns c
195 JOIN [$db].dbo.sysobjects o
197 WHERE o.name = @{[ $self->dbh->quote($table->name) ]}
198 AND o.type IN ('U', 'V')
199 AND o.uid = @{[ $self->_uid($db, $owner) ]}
207 my ($self, $table) = @_;
209 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
211 my $db = $table->database;
213 $self->dbh->do("USE [$db]");
215 local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
217 my $sth = $self->dbh->prepare(<<"EOF");
218 sp_pkeys @{[ $self->dbh->quote($table->name) ]},
219 @{[ $self->dbh->quote($table->schema) ]},
220 @{[ $self->dbh->quote($db) ]}
226 while (my $row = $sth->fetchrow_hashref) {
227 push @keydata, $row->{column_name};
230 $self->dbh->do("USE [$current_db]");
236 my ($self, $table) = @_;
238 my $db = $table->database;
239 my $owner = $table->schema;
241 my $sth = $self->dbh->prepare(<<"EOF");
242 SELECT 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
247 FROM [$db].dbo.sysreferences sr
248 JOIN [$db].dbo.sysobjects so1
249 ON sr.tableid = so1.id
250 JOIN [$db].dbo.sysusers su1
252 JOIN master.dbo.sysdatabases sd2
253 ON sr.pmrydbid = sd2.dbid
254 WHERE so1.name = @{[ $self->dbh->quote($table->name) ]}
255 AND su1.name = @{[ $self->dbh->quote($table->schema) ]}
261 REL: while (my @rel = $sth->fetchrow_array) {
262 my ($remote_tab_id, $remote_db, $key_cnt) = splice @rel, 0, 3;
264 my ($remote_tab_owner, $remote_tab_name) =
265 $self->dbh->selectrow_array(<<"EOF");
266 SELECT su.name, so.name
267 FROM [$remote_db].dbo.sysusers su
268 JOIN [$remote_db].dbo.sysobjects so
270 WHERE so.id = $remote_tab_id
274 unless any { $_ eq $remote_tab_owner }
275 @{ $self->db_schema->{$remote_db} || [] };
277 my @local_col_ids = splice @rel, 0, 16;
278 my @remote_col_ids = splice @rel, 0, 16;
280 @local_col_ids = splice @local_col_ids, 0, $key_cnt;
281 @remote_col_ids = splice @remote_col_ids, 0, $key_cnt;
283 my $remote_table = DBIx::Class::Schema::Loader::Table::Sybase->new(
285 name => $remote_tab_name,
286 database => $remote_db,
287 schema => $remote_tab_owner,
290 my $all_local_cols = $self->_table_columns($table);
291 my $all_remote_cols = $self->_table_columns($remote_table);
293 my @local_cols = map $all_local_cols->[$_-1], @local_col_ids;
294 my @remote_cols = map $all_remote_cols->[$_-1], @remote_col_ids;
296 next REL if (any { not defined $_ } @local_cols)
297 || (any { not defined $_ } @remote_cols);
300 local_columns => \@local_cols,
301 remote_table => $remote_table,
302 remote_columns => \@remote_cols,
309 sub _table_uniq_info {
310 my ($self, $table) = @_;
312 my $db = $table->database;
313 my $owner = $table->schema;
314 my $uid = $self->_uid($db, $owner);
316 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
318 $self->dbh->do("USE [$db]");
320 my $sth = $self->dbh->prepare(<<"EOF");
321 SELECT si.name, si.indid, si.keycnt
322 FROM [$db].dbo.sysindexes si
323 JOIN [$db].dbo.sysobjects so
325 WHERE so.name = @{[ $self->dbh->quote($table->name) ]}
328 AND si.status & 2048 <> 2048
329 AND si.status2 & 2 = 2
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");
339 @{[ $self->dbh->quote($table->name) ]},
340 $ind_id, $col_idx, $uid
343 last COLS unless defined $next_col;
345 push @{ $uniqs{$ind_name} }, $next_col;
349 my @uniqs = map { [ $_ => $uniqs{$_} ] } keys %uniqs;
351 $self->dbh->do("USE [$current_db]");
356 sub _columns_info_for {
359 my $result = $self->next::method(@_);
361 my $db = $table->database;
362 my $owner = $table->schema;
363 my $uid = $self->_uid($db, $owner);
365 local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
366 my $sth = $self->dbh->prepare(<<"EOF");
367 SELECT c.name, bt.name base_type, ut.name user_type, c.prec prec, c.scale scale, c.length len, c.cdefault dflt_id, c.computedcol comp_id, (c.status & 0x80) is_id
368 FROM [$db].dbo.syscolumns c
369 LEFT JOIN [$db].dbo.sysobjects o ON c.id = o.id
370 LEFT JOIN [$db].dbo.systypes bt ON c.type = bt.type
371 LEFT JOIN [$db].dbo.systypes ut ON c.usertype = ut.usertype
372 WHERE o.name = @{[ $self->dbh->quote($table) ]}
374 AND o.type IN ('U', 'V')
377 my $info = $sth->fetchall_hashref('name');
379 while (my ($col, $res) = each %$result) {
380 $res->{data_type} = $info->{$col}{user_type} || $info->{$col}{base_type};
382 if ($info->{$col}{is_id}) {
383 $res->{is_auto_increment} = 1;
387 # column has default value
388 if (my $default_id = $info->{$col}{dflt_id}) {
389 my $sth = $self->dbh->prepare(<<"EOF");
390 SELECT cm.id, cm.text
391 FROM [$db].dbo.syscomments cm
392 WHERE cm.id = $default_id
396 if (my ($d_id, $default) = $sth->fetchrow_array) {
397 my $constant_default = ($default =~ /^DEFAULT \s+ (\S.*\S)/ix)
401 $constant_default = substr($constant_default, 1, length($constant_default) - 2)
402 if ( substr($constant_default, 0, 1) =~ m{['"\[]}
403 && substr($constant_default, -1) =~ m{['"\]]});
405 $res->{default_value} = $constant_default;
409 # column is a computed value
410 if (my $comp_id = $info->{$col}{comp_id}) {
411 my $sth = $self->dbh->prepare(<<"EOF");
412 SELECT cm.id, cm.text
413 FROM [$db].dbo.syscomments cm
414 WHERE cm.id = $comp_id
417 if (my ($c_id, $comp) = $sth->fetchrow_array) {
418 my $function = ($comp =~ /^AS \s+ (\S+)/ix) ? $1 : $comp;
419 $res->{default_value} = \$function;
421 if ($function =~ /^getdate\b/) {
422 $res->{inflate_datetime} = 1;
426 $res->{data_type} = undef;
430 if (my $data_type = $res->{data_type}) {
431 if ($data_type eq 'int') {
432 $data_type = $res->{data_type} = 'integer';
434 elsif ($data_type eq 'decimal') {
435 $data_type = $res->{data_type} = 'numeric';
437 elsif ($data_type eq 'float') {
438 $data_type = $res->{data_type}
439 = ($info->{$col}{len} <= 4 ? 'real' : 'double precision');
442 if ($data_type eq 'timestamp') {
443 $res->{inflate_datetime} = 0;
446 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) {
449 elsif ($data_type eq 'numeric') {
450 my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/};
452 if (!defined $prec && !defined $scale) {
453 $data_type = $res->{data_type} = 'integer';
456 elsif ($prec == 18 && $scale == 0) {
460 $res->{size} = [ $prec, $scale ];
463 elsif ($data_type =~ /char/) {
464 $res->{size} = $info->{$col}{len};
466 if ($data_type =~ /^(?:unichar|univarchar)\z/i) {
469 elsif ($data_type =~ /^n(?:var)?char\z/i) {
470 my ($nchar_size) = $self->dbh->selectrow_array('SELECT @@ncharsize');
472 $res->{size} /= $nchar_size;
483 L<DBIx::Class::Schema::Loader::DBI::Sybase::Common>,
484 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
485 L<DBIx::Class::Schema::Loader::DBI>
489 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
493 This library is free software; you can redistribute it and/or modify it under
494 the same terms as Perl itself.
499 # vim:et sts=4 sw=4 tw=0: