use base 'DBIx::Class::Schema::Loader::DBI::Sybase::Common';
use mro 'c3';
use Try::Tiny;
-use List::MoreUtils 'any';
+use List::Util 'any';
use namespace::clean;
use DBIx::Class::Schema::Loader::Table::Sybase ();
-our $VERSION = '0.07018';
+our $VERSION = '0.07047';
=head1 NAME
=cut
+# SQL Server 2000: Ancient as time itself, but still out in the wild
+sub _is_2k {
+ return shift->schema->storage->_server_info->{normalized_dbms_version} < 9;
+}
+
sub _system_databases {
return (qw/
master model tempdb msdb
/);
}
-sub _owners {
+sub _schemas {
my ($self, $db) = @_;
- my $owners = $self->dbh->selectcol_arrayref(<<"EOF");
+ my $owners = $self->dbh->selectcol_arrayref($self->_is_2k ? <<"EOF2K" : <<"EOF");
SELECT name
FROM [$db].dbo.sysusers
WHERE uid <> gid
+EOF2K
+SELECT name
+FROM [$db].sys.schemas
EOF
return grep !/^(?:#|guest|INFORMATION_SCHEMA|sys)/, @$owners;
}
+sub _current_schema {
+ my $self = shift;
+
+ if ($self->_is_2k) {
+ return ($self->dbh->selectrow_array('SELECT user_name()'))[0];
+ }
+
+ return ($self->dbh->selectrow_array('SELECT schema_name()'))[0];
+}
+
sub _current_db {
my $self = shift;
return ($self->dbh->selectrow_array('SELECT db_name()'))[0];
}
else {
if ($db ne $current_db) {
- $self->dbh->do("USE [$db]");
+ $self->_switch_db($db);
$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()') ];
+ $owners ||= [ $self->_current_schema ];
$self->qualify_objects(1) if @$owners > 1;
foreach my $db (keys %{ $self->db_schema }) {
if ($self->db_schema->{$db} eq '%') {
- $self->db_schema->{$db} = [ $self->_owners($db) ];
+ $self->db_schema->{$db} = [ $self->_schemas($db) ];
$self->qualify_objects(1);
}
}
sub _tables_list {
- my ($self, $opts) = @_;
+ my ($self) = @_;
my @tables;
}
}
- return $self->_filter_tables(\@tables, $opts);
+ return $self->_filter_tables(\@tables);
}
sub _table_pk_info {
my $db = $table->database;
my $sth = $self->dbh->prepare(<<"EOF");
-SELECT rc.constraint_name, rc.unique_constraint_schema, uk_tc.table_name, fk_kcu.column_name, uk_kcu.column_name
+SELECT rc.constraint_name, rc.unique_constraint_schema, uk_tc.table_name,
+ fk_kcu.column_name, uk_kcu.column_name, rc.delete_rule, rc.update_rule
FROM [$db].INFORMATION_SCHEMA.TABLE_CONSTRAINTS fk_tc
JOIN [$db].INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc
ON rc.constraint_name = fk_tc.constraint_name
JOIN [$db].INFORMATION_SCHEMA.KEY_COLUMN_USAGE fk_kcu
ON fk_kcu.constraint_name = fk_tc.constraint_name
AND fk_kcu.table_name = fk_tc.table_name
- AND fk_kcu.table_schema = fk_tc.table_schema
+ AND fk_kcu.table_schema = fk_tc.table_schema
JOIN [$db].INFORMATION_SCHEMA.TABLE_CONSTRAINTS uk_tc
ON uk_tc.constraint_name = rc.unique_constraint_name
AND uk_tc.table_schema = rc.unique_constraint_schema
my %rels;
- while (my ($fk, $remote_schema, $remote_table, $col, $remote_col) = $sth->fetchrow_array) {
+ while (my ($fk, $remote_schema, $remote_table, $col, $remote_col,
+ $delete_rule, $update_rule) = $sth->fetchrow_array) {
push @{ $rels{$fk}{local_columns} }, $self->_lc($col);
push @{ $rels{$fk}{remote_columns} }, $self->_lc($remote_col);
-
+
$rels{$fk}{remote_table} = DBIx::Class::Schema::Loader::Table::Sybase->new(
loader => $self,
name => $remote_table,
database => $db,
schema => $remote_schema,
) unless exists $rels{$fk}{remote_table};
+
+ $rels{$fk}{attrs} ||= {
+ on_delete => uc $delete_rule,
+ on_update => uc $update_rule,
+ is_deferrable => 1 # constraints can be temporarily disabled, but DEFERRABLE is not supported
+ };
}
return [ values %rels ];
push @{ $uniq{$constr} }, $self->_lc($col);
}
- return [ map [ $_ => $uniq{$_} ], keys %uniq ];
+ return [ map [ $_ => $uniq{$_} ], sort keys %uniq ];
}
sub _columns_info_for {
my $result = $self->next::method(@_);
- while (my ($col, $info) = each %$result) {
-# get type info
- my ($char_max_length, $data_type, $datetime_precision, $default) =
- $self->dbh->selectrow_array(<<"EOF");
-SELECT character_maximum_length, data_type, datetime_precision, column_default
-FROM [$db].INFORMATION_SCHEMA.COLUMNS
-WHERE table_name = @{[ $self->dbh->quote($table->name) ]}
- AND table_schema = @{[ $self->dbh->quote($table->schema) ]}
- AND @{[ $self->preserve_case ?
- "column_name = @{[ $self->dbh->quote($col) ]}"
- :
- "lower(column_name) = @{[ $self->dbh->quote(lc $col) ]}" ]}
+ # get type info (and identity)
+ my $rows = $self->dbh->selectall_arrayref($self->_is_2k ? <<"EOF2K" : <<"EOF");
+SELECT c.column_name, c.character_maximum_length, c.data_type, c.datetime_precision, c.column_default, (sc.status & 0x80) is_identity
+FROM [$db].INFORMATION_SCHEMA.COLUMNS c
+JOIN [$db].dbo.sysusers ss ON
+ c.table_schema = ss.name
+JOIN [$db].dbo.sysobjects so ON
+ c.table_name = so.name
+ AND so.uid = ss.uid
+JOIN [$db].dbo.syscolumns sc ON
+ c.column_name = sc.name
+ AND sc.id = so.Id
+WHERE c.table_schema = @{[ $self->dbh->quote($table->schema) ]}
+ AND c.table_name = @{[ $self->dbh->quote($table->name) ]}
+EOF2K
+SELECT c.column_name, c.character_maximum_length, c.data_type, c.datetime_precision, c.column_default, sc.is_identity
+FROM [$db].INFORMATION_SCHEMA.COLUMNS c
+JOIN [$db].sys.schemas ss ON
+ c.table_schema = ss.name
+JOIN [$db].sys.objects so ON
+ c.table_name = so.name
+ AND so.schema_id = ss.schema_id
+JOIN [$db].sys.columns sc ON
+ c.column_name = sc.name
+ AND sc.object_id = so.object_id
+WHERE c.table_schema = @{[ $self->dbh->quote($table->schema) ]}
+ AND c.table_name = @{[ $self->dbh->quote($table->name) ]}
EOF
+ foreach my $row (@$rows) {
+ my ($col, $char_max_length, $data_type, $datetime_precision, $default, $is_identity) = @$row;
+ $col = lc $col unless $self->preserve_case;
+ my $info = $result->{$col} || next;
+
$info->{data_type} = $data_type;
if (defined $char_max_length) {
$info->{size} = 0 if $char_max_length < 0;
}
-# find identities
- my ($is_identity) = $self->dbh->selectrow_array(<<"EOF");
-SELECT is_identity
-FROM [$db].sys.columns
-WHERE object_id = (
- SELECT object_id
- FROM [$db].sys.objects
- WHERE name = @{[ $self->dbh->quote($table->name) ]}
- AND schema_id = (
- SELECT schema_id
- FROM [$db].sys.schemas
- WHERE name = @{[ $self->dbh->quote($table->schema) ]}
- )
-) AND @{[ $self->preserve_case ?
- "name = @{[ $self->dbh->quote($col) ]}"
- :
- "lower(name) = @{[ $self->dbh->quote(lc $col) ]}" ]}
-EOF
if ($is_identity) {
$info->{is_auto_increment} = 1;
$info->{data_type} =~ s/\s*identity//i;
delete $info->{size};
}
-# fix types
+ # fix types
if ($data_type eq 'int') {
$info->{data_type} = 'integer';
}
L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
L<DBIx::Class::Schema::Loader::DBI>
-=head1 AUTHOR
+=head1 AUTHORS
-See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHORS>.
=head1 LICENSE
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff