1 package DBIx::Class::Schema::Loader::DBI::Sybase;
5 use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common';
10 use DBIx::Class::Schema::Loader::Table::Sybase ();
12 our $VERSION = '0.07045';
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);
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);
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 $self->dbh->do("USE [$current_db]");
351 return [ map { [ $_ => $uniqs{$_} ] } sort keys %uniqs ];
354 sub _columns_info_for {
357 my $result = $self->next::method(@_);
359 my $db = $table->database;
360 my $owner = $table->schema;
361 my $uid = $self->_uid($db, $owner);
363 local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
364 my $sth = $self->dbh->prepare(<<"EOF");
365 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
366 FROM [$db].dbo.syscolumns c
367 LEFT JOIN [$db].dbo.sysobjects o ON c.id = o.id
368 LEFT JOIN [$db].dbo.systypes bt ON c.type = bt.type
369 LEFT JOIN [$db].dbo.systypes ut ON c.usertype = ut.usertype
370 WHERE o.name = @{[ $self->dbh->quote($table) ]}
372 AND o.type IN ('U', 'V')
375 my $info = $sth->fetchall_hashref('name');
377 while (my ($col, $res) = each %$result) {
378 $res->{data_type} = $info->{$col}{user_type} || $info->{$col}{base_type};
380 if ($info->{$col}{is_id}) {
381 $res->{is_auto_increment} = 1;
385 # column has default value
386 if (my $default_id = $info->{$col}{dflt_id}) {
387 my $sth = $self->dbh->prepare(<<"EOF");
388 SELECT cm.id, cm.text
389 FROM [$db].dbo.syscomments cm
390 WHERE cm.id = $default_id
394 if (my ($d_id, $default) = $sth->fetchrow_array) {
395 my $constant_default = ($default =~ /^DEFAULT \s+ (\S.*\S)/ix)
399 $constant_default = substr($constant_default, 1, length($constant_default) - 2)
400 if ( substr($constant_default, 0, 1) =~ m{['"\[]}
401 && substr($constant_default, -1) =~ m{['"\]]});
403 $res->{default_value} = $constant_default;
407 # column is a computed value
408 if (my $comp_id = $info->{$col}{comp_id}) {
409 my $sth = $self->dbh->prepare(<<"EOF");
410 SELECT cm.id, cm.text
411 FROM [$db].dbo.syscomments cm
412 WHERE cm.id = $comp_id
415 if (my ($c_id, $comp) = $sth->fetchrow_array) {
416 my $function = ($comp =~ /^AS \s+ (\S+)/ix) ? $1 : $comp;
417 $res->{default_value} = \$function;
419 if ($function =~ /^getdate\b/) {
420 $res->{inflate_datetime} = 1;
424 $res->{data_type} = undef;
428 if (my $data_type = $res->{data_type}) {
429 if ($data_type eq 'int') {
430 $data_type = $res->{data_type} = 'integer';
432 elsif ($data_type eq 'decimal') {
433 $data_type = $res->{data_type} = 'numeric';
435 elsif ($data_type eq 'float') {
436 $data_type = $res->{data_type}
437 = ($info->{$col}{len} <= 4 ? 'real' : 'double precision');
440 if ($data_type eq 'timestamp') {
441 $res->{inflate_datetime} = 0;
444 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) {
447 elsif ($data_type eq 'numeric') {
448 my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/};
450 if (!defined $prec && !defined $scale) {
451 $data_type = $res->{data_type} = 'integer';
454 elsif ($prec == 18 && $scale == 0) {
458 $res->{size} = [ $prec, $scale ];
461 elsif ($data_type =~ /char/) {
462 $res->{size} = $info->{$col}{len};
464 if ($data_type =~ /^(?:unichar|univarchar)\z/i) {
467 elsif ($data_type =~ /^n(?:var)?char\z/i) {
468 my ($nchar_size) = $self->dbh->selectrow_array('SELECT @@ncharsize');
470 $res->{size} /= $nchar_size;
481 L<DBIx::Class::Schema::Loader::DBI::Sybase::Common>,
482 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
483 L<DBIx::Class::Schema::Loader::DBI>
487 See L<DBIx::Class::Schema::Loader/AUTHORS>.
491 This library is free software; you can redistribute it and/or modify it under
492 the same terms as Perl itself.
497 # vim:et sts=4 sw=4 tw=0: