1 package DBIx::Class::Schema::Loader::DBI::Sybase;
5 use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common';
8 use DBIx::Class::Schema::Loader::Table::Sybase ();
11 our $VERSION = '0.07047';
15 DBIx::Class::Schema::Loader::DBI::Sybase - DBIx::Class::Schema::Loader::DBI
16 Sybase ASE Implementation.
20 See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
22 This class reblesses into the L<DBIx::Class::Schema::Loader::DBI::Sybase::Microsoft_SQL_Server> class for connections to MSSQL.
29 my $dbh = $self->schema->storage->dbh;
30 my $DBMS_VERSION = @{$dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2];
31 if ($DBMS_VERSION =~ /^Microsoft /i) {
32 $DBMS_VERSION =~ s/\s/_/g;
33 my $subclass = "DBIx::Class::Schema::Loader::DBI::Sybase::$DBMS_VERSION";
34 if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
35 bless $self, $subclass;
41 sub _system_databases {
43 master model sybsystemdb sybsystemprocs tempdb
56 $self->next::method(@_);
58 $self->preserve_case(1);
60 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
62 if (ref $self->db_schema eq 'HASH') {
63 if (keys %{ $self->db_schema } < 2) {
64 my ($db) = keys %{ $self->db_schema };
69 my $owners = $self->db_schema->{$db};
71 my $db_names = $self->dbh->selectcol_arrayref(<<'EOF');
73 FROM master.dbo.sysdatabases
78 foreach my $db_name (@$db_names) {
80 unless any { $_ eq $db_name } $self->_system_databases;
85 DB: foreach my $db (@dbs) {
86 if (not ((ref $owners eq 'ARRAY' && $owners->[0] eq '%') || $owners eq '%')) {
89 foreach my $owner (@$owners) {
91 if defined $self->_uid($db, $owner);
94 next DB unless @owners;
96 $self->db_schema->{$db} = \@owners;
99 # for post-processing below
100 $self->db_schema->{$db} = '%';
104 $self->qualify_objects(1);
107 if ($db ne $current_db) {
108 $self->dbh->do("USE [$db]");
110 $self->qualify_objects(1);
115 $self->qualify_objects(1);
118 elsif (ref $self->db_schema eq 'ARRAY' || (not defined $self->db_schema)) {
119 my $owners = $self->db_schema;
120 $owners ||= [ $self->dbh->selectrow_array('SELECT user_name()') ];
122 $self->qualify_objects(1) if @$owners > 1;
124 $self->db_schema({ $current_db => $owners });
127 foreach my $db (keys %{ $self->db_schema }) {
128 if ($self->db_schema->{$db} eq '%') {
129 my $owners = $self->dbh->selectcol_arrayref(<<"EOF");
131 FROM [$db].dbo.sysusers
134 $self->db_schema->{$db} = $owners;
136 $self->qualify_objects(1);
146 while (my ($db, $owners) = each %{ $self->db_schema }) {
147 foreach my $owner (@$owners) {
148 my ($uid) = $self->_uid($db, $owner);
150 my $table_names = $self->dbh->selectcol_arrayref(<<"EOF");
152 FROM [$db].dbo.sysobjects
154 AND type IN ('U', 'V')
157 TABLE: foreach my $table_name (@$table_names) {
158 next TABLE if any { $_ eq $table_name } $self->_system_tables;
160 push @tables, DBIx::Class::Schema::Loader::Table::Sybase->new(
170 return $self->_filter_tables(\@tables);
174 my ($self, $db, $owner) = @_;
176 my ($uid) = $self->dbh->selectrow_array(<<"EOF");
178 FROM [$db].dbo.sysusers
179 WHERE name = @{[ $self->dbh->quote($owner) ]}
186 my ($self, $table) = @_;
188 my $db = $table->database;
189 my $owner = $table->schema;
191 my $columns = $self->dbh->selectcol_arrayref(<<"EOF");
193 FROM [$db].dbo.syscolumns c
194 JOIN [$db].dbo.sysobjects o
196 WHERE o.name = @{[ $self->dbh->quote($table->name) ]}
197 AND o.type IN ('U', 'V')
198 AND o.uid = @{[ $self->_uid($db, $owner) ]}
206 my ($self, $table) = @_;
208 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
210 my $db = $table->database;
212 $self->dbh->do("USE [$db]");
214 local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
216 my $sth = $self->dbh->prepare(<<"EOF");
217 sp_pkeys @{[ $self->dbh->quote($table->name) ]},
218 @{[ $self->dbh->quote($table->schema) ]},
219 @{[ $self->dbh->quote($db) ]}
225 while (my $row = $sth->fetchrow_hashref) {
226 push @keydata, $row->{column_name};
229 $self->dbh->do("USE [$current_db]");
235 my ($self, $table) = @_;
237 my $db = $table->database;
238 my $owner = $table->schema;
240 my $sth = $self->dbh->prepare(<<"EOF");
241 SELECT sr.reftabid, sd2.name, sr.keycnt,
242 fokey1, fokey2, fokey3, fokey4, fokey5, fokey6, fokey7, fokey8,
243 fokey9, fokey10, fokey11, fokey12, fokey13, fokey14, fokey15, fokey16,
244 refkey1, refkey2, refkey3, refkey4, refkey5, refkey6, refkey7, refkey8,
245 refkey9, refkey10, refkey11, refkey12, refkey13, refkey14, refkey15, refkey16
246 FROM [$db].dbo.sysreferences sr
247 JOIN [$db].dbo.sysobjects so1
248 ON sr.tableid = so1.id
249 JOIN [$db].dbo.sysusers su1
251 JOIN master.dbo.sysdatabases sd2
252 ON sr.pmrydbid = sd2.dbid
253 WHERE so1.name = @{[ $self->dbh->quote($table->name) ]}
254 AND su1.name = @{[ $self->dbh->quote($table->schema) ]}
260 REL: while (my @rel = $sth->fetchrow_array) {
261 my ($remote_tab_id, $remote_db, $key_cnt) = splice @rel, 0, 3;
263 my ($remote_tab_owner, $remote_tab_name) =
264 $self->dbh->selectrow_array(<<"EOF");
265 SELECT su.name, so.name
266 FROM [$remote_db].dbo.sysusers su
267 JOIN [$remote_db].dbo.sysobjects so
269 WHERE so.id = $remote_tab_id
273 unless any { $_ eq $remote_tab_owner }
274 @{ $self->db_schema->{$remote_db} || [] };
276 my @local_col_ids = splice @rel, 0, 16;
277 my @remote_col_ids = splice @rel, 0, 16;
279 @local_col_ids = splice @local_col_ids, 0, $key_cnt;
280 @remote_col_ids = splice @remote_col_ids, 0, $key_cnt;
282 my $remote_table = DBIx::Class::Schema::Loader::Table::Sybase->new(
284 name => $remote_tab_name,
285 database => $remote_db,
286 schema => $remote_tab_owner,
289 my $all_local_cols = $self->_table_columns($table);
290 my $all_remote_cols = $self->_table_columns($remote_table);
292 my @local_cols = map $all_local_cols->[$_-1], @local_col_ids;
293 my @remote_cols = map $all_remote_cols->[$_-1], @remote_col_ids;
295 next REL if (any { not defined $_ } @local_cols)
296 || (any { not defined $_ } @remote_cols);
299 local_columns => \@local_cols,
300 remote_table => $remote_table,
301 remote_columns => \@remote_cols,
308 sub _table_uniq_info {
309 my ($self, $table) = @_;
311 my $db = $table->database;
312 my $owner = $table->schema;
313 my $uid = $self->_uid($db, $owner);
315 my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()');
317 $self->dbh->do("USE [$db]");
319 my $sth = $self->dbh->prepare(<<"EOF");
320 SELECT si.name, si.indid, si.keycnt
321 FROM [$db].dbo.sysindexes si
322 JOIN [$db].dbo.sysobjects so
324 WHERE so.name = @{[ $self->dbh->quote($table->name) ]}
327 AND si.status & 2048 <> 2048
328 AND si.status2 & 2 = 2
334 while (my ($ind_name, $ind_id, $key_cnt) = $sth->fetchrow_array) {
335 COLS: foreach my $col_idx (1 .. ($key_cnt+1)) {
336 my ($next_col) = $self->dbh->selectrow_array(<<"EOF");
338 @{[ $self->dbh->quote($table->name) ]},
339 $ind_id, $col_idx, $uid
342 last COLS unless defined $next_col;
344 push @{ $uniqs{$ind_name} }, $next_col;
348 $self->dbh->do("USE [$current_db]");
350 return [ map { [ $_ => $uniqs{$_} ] } sort keys %uniqs ];
353 sub _columns_info_for {
356 my $result = $self->next::method(@_);
358 my $db = $table->database;
359 my $owner = $table->schema;
360 my $uid = $self->_uid($db, $owner);
362 local $self->dbh->{FetchHashKeyName} = 'NAME_lc';
363 my $sth = $self->dbh->prepare(<<"EOF");
364 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
365 FROM [$db].dbo.syscolumns c
366 LEFT JOIN [$db].dbo.sysobjects o ON c.id = o.id
367 LEFT JOIN [$db].dbo.systypes bt ON c.type = bt.type
368 LEFT JOIN [$db].dbo.systypes ut ON c.usertype = ut.usertype
369 WHERE o.name = @{[ $self->dbh->quote($table) ]}
371 AND o.type IN ('U', 'V')
374 my $info = $sth->fetchall_hashref('name');
376 while (my ($col, $res) = each %$result) {
377 $res->{data_type} = $info->{$col}{user_type} || $info->{$col}{base_type};
379 if ($info->{$col}{is_id}) {
380 $res->{is_auto_increment} = 1;
384 # column has default value
385 if (my $default_id = $info->{$col}{dflt_id}) {
386 my $sth = $self->dbh->prepare(<<"EOF");
387 SELECT cm.id, cm.text
388 FROM [$db].dbo.syscomments cm
389 WHERE cm.id = $default_id
393 if (my ($d_id, $default) = $sth->fetchrow_array) {
394 my $constant_default = ($default =~ /^DEFAULT \s+ (\S.*\S)/ix)
398 $constant_default = substr($constant_default, 1, length($constant_default) - 2)
399 if ( substr($constant_default, 0, 1) =~ m{['"\[]}
400 && substr($constant_default, -1) =~ m{['"\]]});
402 $res->{default_value} = $constant_default;
406 # column is a computed value
407 if (my $comp_id = $info->{$col}{comp_id}) {
408 my $sth = $self->dbh->prepare(<<"EOF");
409 SELECT cm.id, cm.text
410 FROM [$db].dbo.syscomments cm
411 WHERE cm.id = $comp_id
414 if (my ($c_id, $comp) = $sth->fetchrow_array) {
415 my $function = ($comp =~ /^AS \s+ (\S+)/ix) ? $1 : $comp;
416 $res->{default_value} = \$function;
418 if ($function =~ /^getdate\b/) {
419 $res->{inflate_datetime} = 1;
423 $res->{data_type} = undef;
427 if (my $data_type = $res->{data_type}) {
428 if ($data_type eq 'int') {
429 $data_type = $res->{data_type} = 'integer';
431 elsif ($data_type eq 'decimal') {
432 $data_type = $res->{data_type} = 'numeric';
434 elsif ($data_type eq 'float') {
435 $data_type = $res->{data_type}
436 = ($info->{$col}{len} <= 4 ? 'real' : 'double precision');
439 if ($data_type eq 'timestamp') {
440 $res->{inflate_datetime} = 0;
443 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) {
446 elsif ($data_type eq 'numeric') {
447 my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/};
449 if (!defined $prec && !defined $scale) {
450 $data_type = $res->{data_type} = 'integer';
453 elsif ($prec == 18 && $scale == 0) {
457 $res->{size} = [ $prec, $scale ];
460 elsif ($data_type =~ /char/) {
461 $res->{size} = $info->{$col}{len};
463 if ($data_type =~ /^(?:unichar|univarchar)\z/i) {
466 elsif ($data_type =~ /^n(?:var)?char\z/i) {
467 my ($nchar_size) = $self->dbh->selectrow_array('SELECT @@ncharsize');
469 $res->{size} /= $nchar_size;
480 L<DBIx::Class::Schema::Loader::DBI::Sybase::Common>,
481 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
482 L<DBIx::Class::Schema::Loader::DBI>
486 See L<DBIx::Class::Schema::Loader/AUTHORS>.
490 This library is free software; you can redistribute it and/or modify it under
491 the same terms as Perl itself.
496 # vim:et sts=4 sw=4 tw=0: