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.07020';
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 name, bt.name base_type, ut.name user_type, cm.text deflt, c.prec prec, c.scale scale, c.length len
368 FROM [$db].dbo.syscolumns c
369 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 LEFT JOIN [$db].dbo.syscomments cm
373 ON cm.id = CASE WHEN c.cdefault = 0 THEN c.computedcol ELSE c.cdefault END
374 WHERE o.name = @{[ $self->dbh->quote($table) ]}
376 AND o.type IN ('U', 'V')
379 my $info = $sth->fetchall_hashref('name');
381 while (my ($col, $res) = each %$result) {
382 my $data_type = $res->{data_type} = $info->{$col}{user_type} || $info->{$col}{base_type};
384 # check if it's an IDENTITY column
385 my $sth = $self->dbh->prepare(<<"EOF");
387 FROM [$db].dbo.syscolumns
390 FROM [$db].dbo.sysobjects
391 WHERE name = @{[ $self->dbh->quote($table->name) ]}
394 AND (status & 0x80) = 0x80
395 AND name = @{[ $self->dbh->quote($col) ]}
399 if ($sth->fetchrow_array) {
400 $res->{is_auto_increment} = 1;
403 if ($data_type && $data_type =~ /^timestamp\z/i) {
404 $res->{inflate_datetime} = 0;
407 if (my $default = $info->{$col}{deflt}) {
408 if ($default =~ /^AS \s+ (\S+)/ix) {
410 $res->{default_value} = \$function;
412 if ($function =~ /^getdate\b/) {
413 $res->{inflate_datetime} = 1;
417 $res->{data_type} = undef;
419 elsif ($default =~ /^DEFAULT \s+ (\S+)/ix) {
420 my ($constant_default) = $1 =~ /^['"\[\]]?(.*?)['"\[\]]?\z/;
421 $res->{default_value} = $constant_default;
425 if (my $data_type = $res->{data_type}) {
426 if ($data_type eq 'int') {
427 $data_type = $res->{data_type} = 'integer';
429 elsif ($data_type eq 'decimal') {
430 $data_type = $res->{data_type} = 'numeric';
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) {
436 elsif ($data_type eq 'numeric') {
437 my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/};
439 if ($prec == 18 && $scale == 0) {
443 $res->{size} = [ $prec, $scale ];
446 elsif ($data_type =~ /char/) {
447 $res->{size} = $info->{$col}{len};
449 if ($data_type =~ /^(?:unichar|univarchar)\z/i) {
455 if ($data_type eq 'float') {
456 $res->{data_type} = $info->{$col}{len} <= 4 ? 'real' : 'double precision';
465 L<DBIx::Class::Schema::Loader::DBI::Sybase::Common>,
466 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
467 L<DBIx::Class::Schema::Loader::DBI>
471 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
475 This library is free software; you can redistribute it and/or modify it under
476 the same terms as Perl itself.
481 # vim:et sts=4 sw=4 tw=0: