X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FSybase.pm;h=94b1b684070e48af694b1c4018cdbc474731d125;hb=306bf770bf08b06f92863808b1938f2fc704acb0;hp=96e2fe5d017a75e4415d0db5209cbe3080759ddd;hpb=9a55cbd2347924acadb4fde924a056a93e363dc1;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm index 96e2fe5..94b1b68 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm @@ -2,43 +2,27 @@ package DBIx::Class::Schema::Loader::DBI::Sybase; use strict; use warnings; -use base qw/ - DBIx::Class::Schema::Loader::DBI - DBIx::Class::Schema::Loader::DBI::Sybase::Common -/; -use Carp::Clan qw/^DBIx::Class/; -use Class::C3; +use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common'; +use mro 'c3'; +use List::Util 'any'; +use namespace::clean; -our $VERSION = '0.04999_13'; +use DBIx::Class::Schema::Loader::Table::Sybase (); -=head1 NAME - -DBIx::Class::Schema::Loader::DBI::Sybase - DBIx::Class::Schema::Loader::DBI Sybase Implementation. - -=head1 SYNOPSIS - - package My::Schema; - use base qw/DBIx::Class::Schema::Loader/; +our $VERSION = '0.07047'; - __PACKAGE__->loader_options( debug => 1 ); +=head1 NAME - 1; +DBIx::Class::Schema::Loader::DBI::Sybase - DBIx::Class::Schema::Loader::DBI +Sybase ASE Implementation. =head1 DESCRIPTION -See L. - -=cut - -sub _is_case_sensitive { 1 } +See L and L. -sub _setup { - my $self = shift; +This class reblesses into the L class for connections to MSSQL. - $self->next::method(@_); - $self->{db_schema} ||= $self->_build_db_schema; - $self->_set_quote_char_and_name_sep; -} +=cut sub _rebless { my $self = shift; @@ -51,20 +35,170 @@ sub _rebless { if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { bless $self, $subclass; $self->_rebless; - } + } + } +} + +sub _system_databases { + return (qw/ + master model sybsystemdb sybsystemprocs tempdb + /); +} + +sub _system_tables { + return (qw/ + sysquerymetrics + /); +} + +sub _setup { + my $self = shift; + + $self->next::method(@_); + + $self->preserve_case(1); + + my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()'); + + if (ref $self->db_schema eq 'HASH') { + if (keys %{ $self->db_schema } < 2) { + my ($db) = keys %{ $self->db_schema }; + + $db ||= $current_db; + + if ($db eq '%') { + my $owners = $self->db_schema->{$db}; + + my $db_names = $self->dbh->selectcol_arrayref(<<'EOF'); +SELECT name +FROM master.dbo.sysdatabases +EOF + + my @dbs; + + foreach my $db_name (@$db_names) { + push @dbs, $db_name + unless any { $_ eq $db_name } $self->_system_databases; + } + + $self->db_schema({}); + + DB: foreach my $db (@dbs) { + if (not ((ref $owners eq 'ARRAY' && $owners->[0] eq '%') || $owners eq '%')) { + my @owners; + + foreach my $owner (@$owners) { + push @owners, $owner + if defined $self->_uid($db, $owner); + } + + next DB unless @owners; + + $self->db_schema->{$db} = \@owners; + } + else { + # for post-processing below + $self->db_schema->{$db} = '%'; + } + } + + $self->qualify_objects(1); + } + else { + if ($db ne $current_db) { + $self->dbh->do("USE [$db]"); + + $self->qualify_objects(1); + } + } + } + else { + $self->qualify_objects(1); + } + } + elsif (ref $self->db_schema eq 'ARRAY' || (not defined $self->db_schema)) { + my $owners = $self->db_schema; + $owners ||= [ $self->dbh->selectrow_array('SELECT user_name()') ]; + + $self->qualify_objects(1) if @$owners > 1; + + $self->db_schema({ $current_db => $owners }); } + + foreach my $db (keys %{ $self->db_schema }) { + if ($self->db_schema->{$db} eq '%') { + my $owners = $self->dbh->selectcol_arrayref(<<"EOF"); +SELECT name +FROM [$db].dbo.sysusers +WHERE uid <> gid +EOF + $self->db_schema->{$db} = $owners; + + $self->qualify_objects(1); + } + } +} + +sub _tables_list { + my ($self) = @_; + + my @tables; + + while (my ($db, $owners) = each %{ $self->db_schema }) { + foreach my $owner (@$owners) { + my ($uid) = $self->_uid($db, $owner); + + my $table_names = $self->dbh->selectcol_arrayref(<<"EOF"); +SELECT name +FROM [$db].dbo.sysobjects +WHERE uid = $uid + AND type IN ('U', 'V') +EOF + + TABLE: foreach my $table_name (@$table_names) { + next TABLE if any { $_ eq $table_name } $self->_system_tables; + + push @tables, DBIx::Class::Schema::Loader::Table::Sybase->new( + loader => $self, + name => $table_name, + database => $db, + schema => $owner, + ); + } + } + } + + return $self->_filter_tables(\@tables); +} + +sub _uid { + my ($self, $db, $owner) = @_; + + my ($uid) = $self->dbh->selectrow_array(<<"EOF"); +SELECT uid +FROM [$db].dbo.sysusers +WHERE name = @{[ $self->dbh->quote($owner) ]} +EOF + + return $uid; } sub _table_columns { my ($self, $table) = @_; - my $dbh = $self->schema->storage->dbh; - my $columns = $dbh->selectcol_arrayref(qq{ + my $db = $table->database; + my $owner = $table->schema; + + my $columns = $self->dbh->selectcol_arrayref(<<"EOF"); SELECT c.name -FROM syscolumns c JOIN sysobjects o -ON c.id = o.id -WHERE o.name = @{[ $dbh->quote($table) ]} AND o.type = 'U' -}); +FROM [$db].dbo.syscolumns c +JOIN [$db].dbo.sysobjects o + ON c.id = o.id +WHERE o.name = @{[ $self->dbh->quote($table->name) ]} + AND o.type IN ('U', 'V') + AND o.uid = @{[ $self->_uid($db, $owner) ]} +ORDER BY c.colid ASC +EOF return $columns; } @@ -72,8 +206,19 @@ WHERE o.name = @{[ $dbh->quote($table) ]} AND o.type = 'U' sub _table_pk_info { my ($self, $table) = @_; - my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare(qq{sp_pkeys @{[ $dbh->quote($table) ]}}); + my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()'); + + my $db = $table->database; + + $self->dbh->do("USE [$db]"); + + local $self->dbh->{FetchHashKeyName} = 'NAME_lc'; + + my $sth = $self->dbh->prepare(<<"EOF"); +sp_pkeys @{[ $self->dbh->quote($table->name) ]}, + @{[ $self->dbh->quote($table->schema) ]}, + @{[ $self->dbh->quote($db) ]} +EOF $sth->execute; my @keydata; @@ -82,181 +227,264 @@ sub _table_pk_info { push @keydata, $row->{column_name}; } + $self->dbh->do("USE [$current_db]"); + return \@keydata; } sub _table_fk_info { my ($self, $table) = @_; - # check if FK_NAME is supported - - my $dbh = $self->schema->storage->dbh; - local $dbh->{FetchHashKeyName} = 'NAME_lc'; - # hide "Object does not exist in this database." when trying to fetch fkeys - local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 }; - my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}}); + my $db = $table->database; + my $owner = $table->schema; + + my $sth = $self->dbh->prepare(<<"EOF"); +SELECT sr.reftabid, sd2.name, sr.keycnt, + fokey1, fokey2, fokey3, fokey4, fokey5, fokey6, fokey7, fokey8, + fokey9, fokey10, fokey11, fokey12, fokey13, fokey14, fokey15, fokey16, + refkey1, refkey2, refkey3, refkey4, refkey5, refkey6, refkey7, refkey8, + refkey9, refkey10, refkey11, refkey12, refkey13, refkey14, refkey15, refkey16 +FROM [$db].dbo.sysreferences sr +JOIN [$db].dbo.sysobjects so1 + ON sr.tableid = so1.id +JOIN [$db].dbo.sysusers su1 + ON so1.uid = su1.uid +JOIN master.dbo.sysdatabases sd2 + ON sr.pmrydbid = sd2.dbid +WHERE so1.name = @{[ $self->dbh->quote($table->name) ]} + AND su1.name = @{[ $self->dbh->quote($table->schema) ]} +EOF $sth->execute; - my $row = $sth->fetchrow_hashref; - return unless $row; + my @rels; - if (exists $row->{fk_name}) { - $sth->finish; - return $self->_table_fk_info_by_name($table); - } + REL: while (my @rel = $sth->fetchrow_array) { + my ($remote_tab_id, $remote_db, $key_cnt) = splice @rel, 0, 3; - $sth->finish; - return $self->_table_fk_info_builder($table); -} + my ($remote_tab_owner, $remote_tab_name) = + $self->dbh->selectrow_array(<<"EOF"); +SELECT su.name, so.name +FROM [$remote_db].dbo.sysusers su +JOIN [$remote_db].dbo.sysobjects so + ON su.uid = so.uid +WHERE so.id = $remote_tab_id +EOF -sub _table_fk_info_by_name { - my ($self, $table) = @_; - my ($local_cols, $remote_cols, $remote_table, @rels); + next REL + unless any { $_ eq $remote_tab_owner } + @{ $self->db_schema->{$remote_db} || [] }; - my $dbh = $self->schema->storage->dbh; - local $dbh->{FetchHashKeyName} = 'NAME_lc'; - # hide "Object does not exist in this database." when trying to fetch fkeys - local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 }; - my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}}); - $sth->execute; + my @local_col_ids = splice @rel, 0, 16; + my @remote_col_ids = splice @rel, 0, 16; - while (my $row = $sth->fetchrow_hashref) { - my $fk = $row->{fk_name}; - next unless defined $fk; + @local_col_ids = splice @local_col_ids, 0, $key_cnt; + @remote_col_ids = splice @remote_col_ids, 0, $key_cnt; - push @{$local_cols->{$fk}}, $row->{fkcolumn_name}; - push @{$remote_cols->{$fk}}, $row->{pkcolumn_name}; - $remote_table->{$fk} = $row->{pktable_name}; - } + my $remote_table = DBIx::Class::Schema::Loader::Table::Sybase->new( + loader => $self, + name => $remote_tab_name, + database => $remote_db, + schema => $remote_tab_owner, + ); + + my $all_local_cols = $self->_table_columns($table); + my $all_remote_cols = $self->_table_columns($remote_table); + + my @local_cols = map $all_local_cols->[$_-1], @local_col_ids; + my @remote_cols = map $all_remote_cols->[$_-1], @remote_col_ids; + + next REL if (any { not defined $_ } @local_cols) + || (any { not defined $_ } @remote_cols); - foreach my $fk (keys %$remote_table) { push @rels, { - local_columns => \@{$local_cols->{$fk}}, - remote_columns => \@{$remote_cols->{$fk}}, - remote_table => $remote_table->{$fk}, - }; + local_columns => \@local_cols, + remote_table => $remote_table, + remote_columns => \@remote_cols, + }; + }; - } return \@rels; } -sub _table_fk_info_builder { +sub _table_uniq_info { my ($self, $table) = @_; - my $dbh = $self->schema->storage->dbh; - local $dbh->{FetchHashKeyName} = 'NAME_lc'; - # hide "Object does not exist in this database." when trying to fetch fkeys - local $dbh->{syb_err_handler} = sub { return 0 if $_[0] == 17461; }; - my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = @{[ $dbh->quote($table) ]}}); + my $db = $table->database; + my $owner = $table->schema; + my $uid = $self->_uid($db, $owner); + + my ($current_db) = $self->dbh->selectrow_array('SELECT db_name()'); + + $self->dbh->do("USE [$db]"); + + my $sth = $self->dbh->prepare(<<"EOF"); +SELECT si.name, si.indid, si.keycnt +FROM [$db].dbo.sysindexes si +JOIN [$db].dbo.sysobjects so + ON si.id = so.id +WHERE so.name = @{[ $self->dbh->quote($table->name) ]} + AND so.uid = $uid + AND si.indid > 0 + AND si.status & 2048 <> 2048 + AND si.status2 & 2 = 2 +EOF $sth->execute; - my @fk_info; - while (my $row = $sth->fetchrow_hashref) { - (my $ksq = $row->{key_seq}) =~ s/\s+//g; + my %uniqs; - my @keys = qw/pktable_name pkcolumn_name fktable_name fkcolumn_name/; - my %ds; - @ds{@keys} = @{$row}{@keys}; - $ds{key_seq} = $ksq; + while (my ($ind_name, $ind_id, $key_cnt) = $sth->fetchrow_array) { + COLS: foreach my $col_idx (1 .. ($key_cnt+1)) { + my ($next_col) = $self->dbh->selectrow_array(<<"EOF"); +SELECT index_col( + @{[ $self->dbh->quote($table->name) ]}, + $ind_id, $col_idx, $uid +) +EOF + last COLS unless defined $next_col; - push @{ $fk_info[$ksq] }, \%ds; + push @{ $uniqs{$ind_name} }, $next_col; + } } - my $max_keys = $#fk_info; - my @rels; - for my $level (reverse 1 .. $max_keys) { - my @level_rels; - $level_rels[$level] = splice @fk_info, $level, 1; - my $count = @{ $level_rels[$level] }; - - for my $sub_level (reverse 1 .. $level-1) { - my $total = @{ $fk_info[$sub_level] }; - - $level_rels[$sub_level] = [ - splice @{ $fk_info[$sub_level] }, $total-$count, $count - ]; - } + $self->dbh->do("USE [$current_db]"); - while (1) { - my @rel = map shift @$_, @level_rels[1..$level]; + return [ map { [ $_ => $uniqs{$_} ] } sort keys %uniqs ]; +} - last unless defined $rel[0]; +sub _columns_info_for { + my $self = shift; + my ($table) = @_; + my $result = $self->next::method(@_); + + my $db = $table->database; + my $owner = $table->schema; + my $uid = $self->_uid($db, $owner); + + local $self->dbh->{FetchHashKeyName} = 'NAME_lc'; + my $sth = $self->dbh->prepare(<<"EOF"); +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 +FROM [$db].dbo.syscolumns c +LEFT JOIN [$db].dbo.sysobjects o ON c.id = o.id +LEFT JOIN [$db].dbo.systypes bt ON c.type = bt.type +LEFT JOIN [$db].dbo.systypes ut ON c.usertype = ut.usertype +WHERE o.name = @{[ $self->dbh->quote($table) ]} + AND o.uid = $uid + AND o.type IN ('U', 'V') +EOF + $sth->execute; + my $info = $sth->fetchall_hashref('name'); - my @local_columns = map $_->{fkcolumn_name}, @rel; - my @remote_columns = map $_->{pkcolumn_name}, @rel; - my $remote_table = $rel[0]->{pktable_name}; + while (my ($col, $res) = each %$result) { + $res->{data_type} = $info->{$col}{user_type} || $info->{$col}{base_type}; - push @rels, { - local_columns => \@local_columns, - remote_columns => \@remote_columns, - remote_table => $remote_table - }; + if ($info->{$col}{is_id}) { + $res->{is_auto_increment} = 1; } - } - - return \@rels; -} - -sub _table_uniq_info { - my ($self, $table) = @_; - - local $SIG{__WARN__} = sub {}; + $sth->finish; - my $dbh = $self->schema->storage->dbh; - local $dbh->{FetchHashKeyName} = 'NAME_lc'; - my $sth = $dbh->prepare(qq{sp_helpconstraint \@objname=@{[ $dbh->quote($table) ]}, \@nomsg='nomsg'}); - eval { $sth->execute }; - return if $@; + # column has default value + if (my $default_id = $info->{$col}{dflt_id}) { + my $sth = $self->dbh->prepare(<<"EOF"); +SELECT cm.id, cm.text +FROM [$db].dbo.syscomments cm +WHERE cm.id = $default_id +EOF + $sth->execute; + + if (my ($d_id, $default) = $sth->fetchrow_array) { + my $constant_default = ($default =~ /^DEFAULT \s+ (\S.*\S)/ix) + ? $1 + : $default; + + $constant_default = substr($constant_default, 1, length($constant_default) - 2) + if ( substr($constant_default, 0, 1) =~ m{['"\[]} + && substr($constant_default, -1) =~ m{['"\]]}); + + $res->{default_value} = $constant_default; + } + } - my $constraints; - while (my $row = $sth->fetchrow_hashref) { - if (exists $row->{constraint_type}) { - my $type = $row->{constraint_type} || ''; - if ($type =~ /^unique/i) { - my $name = $row->{constraint_name}; - push @{$constraints->{$name}}, - ( split /,/, $row->{constraint_keys} ); + # column is a computed value + if (my $comp_id = $info->{$col}{comp_id}) { + my $sth = $self->dbh->prepare(<<"EOF"); +SELECT cm.id, cm.text +FROM [$db].dbo.syscomments cm +WHERE cm.id = $comp_id +EOF + $sth->execute; + if (my ($c_id, $comp) = $sth->fetchrow_array) { + my $function = ($comp =~ /^AS \s+ (\S+)/ix) ? $1 : $comp; + $res->{default_value} = \$function; + + if ($function =~ /^getdate\b/) { + $res->{inflate_datetime} = 1; + } + + delete $res->{size}; + $res->{data_type} = undef; } - } else { - my $def = $row->{definition} || next; - next unless $def =~ /^unique/i; - my $name = $row->{name}; - my ($keys) = $def =~ /\((.*)\)/; - $keys =~ s/\s*//g; - my @keys = split /,/ => $keys; - push @{$constraints->{$name}}, @keys; } - } - my @uniqs = map { [ $_ => $constraints->{$_} ] } keys %$constraints; - return \@uniqs; -} + if (my $data_type = $res->{data_type}) { + if ($data_type eq 'int') { + $data_type = $res->{data_type} = 'integer'; + } + elsif ($data_type eq 'decimal') { + $data_type = $res->{data_type} = 'numeric'; + } + elsif ($data_type eq 'float') { + $data_type = $res->{data_type} + = ($info->{$col}{len} <= 4 ? 'real' : 'double precision'); + } -sub _extra_column_info { - my ($self, $info) = @_; - my %extra_info; + if ($data_type eq 'timestamp') { + $res->{inflate_datetime} = 0; + } - my ($table, $column) = @$info{qw/TABLE_NAME COLUMN_NAME/}; + 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) { + delete $res->{size}; + } + elsif ($data_type eq 'numeric') { + my ($prec, $scale) = @{$info->{$col}}{qw/prec scale/}; + + if (!defined $prec && !defined $scale) { + $data_type = $res->{data_type} = 'integer'; + delete $res->{size}; + } + elsif ($prec == 18 && $scale == 0) { + delete $res->{size}; + } + else { + $res->{size} = [ $prec, $scale ]; + } + } + elsif ($data_type =~ /char/) { + $res->{size} = $info->{$col}{len}; - my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare(qq{SELECT name FROM syscolumns WHERE id = (SELECT id FROM sysobjects WHERE name = @{[ $dbh->quote($table) ]}) AND (status & 0x80) = 0x80 AND name = @{[ $dbh->quote($column) ]}}); - $sth->execute(); + if ($data_type =~ /^(?:unichar|univarchar)\z/i) { + $res->{size} /= 2; + } + elsif ($data_type =~ /^n(?:var)?char\z/i) { + my ($nchar_size) = $self->dbh->selectrow_array('SELECT @@ncharsize'); - if ($sth->fetchrow_array) { - $extra_info{is_auto_increment} = 1; + $res->{size} /= $nchar_size; + } + } + } } - return \%extra_info; + return $result; } =head1 SEE ALSO +L, L, L, L -=head1 AUTHOR +=head1 AUTHORS -See L and L. +See L. =head1 LICENSE @@ -266,3 +494,4 @@ the same terms as Perl itself. =cut 1; +# vim:et sts=4 sw=4 tw=0: