X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FSybase.pm;h=7b3ec3da52361e588b1809d5b9736c6ba232c7e9;hb=0852b7b82a006837d0a0318db2fa8b335180d8ba;hp=4c7b7f3f5bcceda99e5c5f06ce4db62a5fdfa094;hpb=fe67d3434ad62ea06e1a483429cb07c744d6c70d;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 4c7b7f3..7b3ec3d 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm @@ -2,7 +2,10 @@ package DBIx::Class::Schema::Loader::DBI::Sybase; use strict; use warnings; -use base 'DBIx::Class::Schema::Loader::DBI'; +use base qw/ + DBIx::Class::Schema::Loader::DBI + DBIx::Class::Schema::Loader::DBI::Sybase::Common +/; use Carp::Clan qw/^DBIx::Class/; use Class::C3; @@ -27,11 +30,14 @@ See L. =cut +sub _is_case_sensitive { 1 } + sub _setup { my $self = shift; $self->next::method(@_); - $self->{db_schema} ||= 'dbo'; + $self->{db_schema} ||= $self->_build_db_schema; + $self->_set_quote_char_and_name_sep; } sub _rebless { @@ -40,10 +46,10 @@ sub _rebless { my $dbh = $self->schema->storage->dbh; my $DBMS_VERSION = @{$dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]; if ($DBMS_VERSION =~ /^Microsoft /i) { - my $subclass = 'DBIx::Class::Schema::Loader::DBI::MSSQL'; - if ($self->load_optional_class($subclass)) { - bless $self, $subclass unless $self->isa($subclass); - $self->_rebless; + my $subclass = 'DBIx::Class::Schema::Loader::DBI::MSSQL'; + if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { + bless $self, $subclass; + $self->_rebless; } } } @@ -67,7 +73,7 @@ sub _table_pk_info { my @keydata; while (my $row = $sth->fetchrow_hashref) { - push @keydata, lc $row->{column_name}; + push @keydata, $row->{column_name}; } return \@keydata; @@ -76,49 +82,143 @@ sub _table_pk_info { 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 = '$table'}); + $sth->execute; + my $row = $sth->fetchrow_hashref; + + return unless $row; + + if (exists $row->{fk_name}) { + $sth->finish; + return $self->_table_fk_info_by_name($table); + } + + $sth->finish; + return $self->_table_fk_info_builder($table); +} + +sub _table_fk_info_by_name { + my ($self, $table) = @_; my ($local_cols, $remote_cols, $remote_table, @rels); + my $dbh = $self->schema->storage->dbh; + local $dbh->{FetchHashKeyName} = 'NAME_lc'; # hide "Object does not exist in this database." when trying to fetch fkeys - $dbh->{syb_err_handler} = sub { return 0 if $_[0] == 17461; }; - my $sth = $dbh->prepare(qq{sp_fkeys \@FKTABLE_NAME = '$table'}); + local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 }; + my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = '$table'}); $sth->execute; while (my $row = $sth->fetchrow_hashref) { - next unless $row->{FK_NAME}; - my $fk = $row->{FK_NAME}; - push @{$local_cols->{$fk}}, lc $row->{FKCOLUMN_NAME}; - push @{$remote_cols->{$fk}}, lc $row->{PKCOLUMN_NAME}; - $remote_table->{$fk} = $row->{PKTABLE_NAME}; + my $fk = $row->{fk_name}; + next unless defined $fk; + + push @{$local_cols->{$fk}}, $row->{fkcolumn_name}; + push @{$remote_cols->{$fk}}, $row->{pkcolumn_name}; + $remote_table->{$fk} = $row->{pktable_name}; } foreach my $fk (keys %$remote_table) { - push @rels, { - local_columns => \@{$local_cols->{$fk}}, - remote_columns => \@{$remote_cols->{$fk}}, - remote_table => $remote_table->{$fk}, - }; + push @rels, { + local_columns => \@{$local_cols->{$fk}}, + remote_columns => \@{$remote_cols->{$fk}}, + remote_table => $remote_table->{$fk}, + }; + + } + return \@rels; +} + +sub _table_fk_info_builder { + 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 = '$table'}); + $sth->execute; + + my @fk_info; + while (my $row = $sth->fetchrow_hashref) { + (my $ksq = $row->{key_seq}) =~ s/\s+//g; + + my @keys = qw/pktable_name pkcolumn_name fktable_name fkcolumn_name/; + my %ds; + @ds{@keys} = @{$row}{@keys}; + $ds{key_seq} = $ksq; + push @{ $fk_info[$ksq] }, \%ds; } + + 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 + ]; + } + + while (1) { + my @rel = map shift @$_, @level_rels[1..$level]; + + last unless defined $rel[0]; + + my @local_columns = map $_->{fkcolumn_name}, @rel; + my @remote_columns = map $_->{pkcolumn_name}, @rel; + my $remote_table = $rel[0]->{pktable_name}; + + push @rels, { + local_columns => \@local_columns, + remote_columns => \@remote_columns, + remote_table => $remote_table + }; + } + } + return \@rels; } sub _table_uniq_info { my ($self, $table) = @_; + local $SIG{__WARN__} = sub {}; + my $dbh = $self->schema->storage->dbh; -# my $sth = $dbh->prepare(qq{SELECT CCU.CONSTRAINT_NAME, CCU.COLUMN_NAME FROM INFORMATION_SCHEMA.CONSTRAINT_COLUMN_USAGE CCU -# JOIN INFORMATION_SCHEMA.TABLE_CONSTRAINTS TC ON (CCU.CONSTRAINT_NAME = TC.CONSTRAINT_NAME) -# JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU ON (CCU.CONSTRAINT_NAME = KCU.CONSTRAINT_NAME AND CCU.COLUMN_NAME = KCU.COLUMN_NAME) -# WHERE CCU.TABLE_NAME = '$table' AND CONSTRAINT_TYPE = 'UNIQUE' ORDER BY KCU.ORDINAL_POSITION}); + local $dbh->{FetchHashKeyName} = 'NAME_lc'; my $sth = $dbh->prepare(qq{sp_helpconstraint \@objname='$table', \@nomsg='nomsg'}); - $sth->execute; + eval { $sth->execute }; + return if $@; my $constraints; while (my $row = $sth->fetchrow_hashref) { - my $type = $row->{constraint_type} || ''; - if ($type =~ /^unique/i) { - my $name = lc $row->{constraint_name}; - push @{$constraints->{$name}}, ( split /,/, lc $row->{constraint_keys} ); + 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} ); + } + } 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; } } @@ -152,6 +252,10 @@ L Justin Hunter C +=head1 CONTRIBUTORS + +Rafael Kitover + =cut 1;