use base 'DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault';
use mro 'c3';
use Try::Tiny;
+use DBIx::Class::Schema::Loader::Utils qw/sigwarn_silencer/;
use namespace::clean;
-our $VERSION = '0.07031';
+our $VERSION = '0.07043';
=head1 NAME
my $self = shift;
# silence a warning from older DBD::Oracles in tests
- my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
- local $SIG{__WARN__} = sub {
- $warn_handler->(@_)
- unless $_[0] =~ /^Field \d+ has an Oracle type \(\d+\) which is not explicitly supported/;
- };
+ local $SIG{__WARN__} = sigwarn_silencer(
+ qr/^Field \d+ has an Oracle type \(\d+\) which is not explicitly supported/
+ );
return $self->next::method(@_);
}
my $deferrable_sth = $self->dbh->prepare_cached(<<'EOF');
select deferrable from all_constraints
-where owner = ? and table_name = ? and constraint_name = ?
+where owner = ? and table_name = ? and constraint_name = ? and status = 'ENABLED'
EOF
+ my @enabled_rels;
foreach my $rel (@$rels) {
# Oracle does not have update rules
$rel->{attrs}{on_update} = 'NO ACTION';;
# DBD::Oracle's foreign_key_info does not return DEFERRABILITY, so we get it ourselves
- my ($deferrable) = $self->dbh->selectrow_array(
+ # Also use this to filter out disabled foreign keys, which are returned by DBD::Oracle < 1.76
+ my $deferrable = $self->dbh->selectrow_array(
$deferrable_sth, undef, $table->schema, $table->name, $rel->{_constraint_name}
- );
+ ) or next;
- $rel->{attrs}{is_deferrable} = $deferrable && $deferrable =~ /^DEFERRABLE/i ? 1 : 0;
+ $rel->{attrs}{is_deferrable} = $deferrable =~ /^DEFERRABLE/i ? 1 : 0;
+ push @enabled_rels, $rel;
}
- return $rels;
+ return \@enabled_rels;
}
sub _table_uniq_info {
WHERE acc.table_name=? AND acc.owner = ?
AND ac.table_name = acc.table_name AND ac.owner = acc.owner
AND acc.constraint_name = ac.constraint_name
- AND ac.constraint_type='U'
+ AND ac.constraint_type = 'U'
+ AND ac.status = 'ENABLED'
ORDER BY acc.position
EOF
push @{$constr_names{$constr_name}}, $constr_col;
}
- my @uniqs = map { [ $_ => $constr_names{$_} ] } keys %constr_names;
- return \@uniqs;
+ return [ map { [ $_ => $constr_names{$_} ] } sort keys %constr_names ];
}
sub _table_comment {
my $sth = $self->dbh->prepare_cached(<<'EOF', {}, 1);
SELECT trigger_body
FROM all_triggers
-WHERE table_name = ? AND table_owner = ?
+WHERE table_name = ? AND table_owner = ? AND status = 'ENABLED'
AND upper(trigger_type) LIKE '%BEFORE EACH ROW%' AND lower(triggering_event) LIKE '%insert%'
EOF
$sth->execute($table->name, $table->schema);
while (my ($trigger_body) = $sth->fetchrow_array) {
- if (my ($seq_schema, $seq_name) = $trigger_body =~ /(?:\."?(\w+)"?)?"?(\w+)"?\.nextval/i) {
+ if (my ($seq_schema, $seq_name) = $trigger_body =~ /(?:"?(\w+)"?\.)?"?(\w+)"?\.nextval/i) {
if (my ($col_name) = $trigger_body =~ /:new\.(\w+)/i) {
$col_name = $self->_lc($col_name);
}
}
+ # Old DBD::Oracle report the size in (UTF-16) bytes, not characters
+ my $nchar_size_factor = $DBD::Oracle::VERSION >= 1.52 ? 1 : 2;
+
while (my ($col, $info) = each %$result) {
no warnings 'uninitialized';
$info->{size} = $info->{size}[0] / 8;
}
else {
- $info->{size} = $info->{size} / 2;
+ $info->{size} = $info->{size} / $nchar_size_factor;
}
}
elsif ($info->{data_type} =~ /^(?:var)?char2?\z/i) {