X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FOracle.pm;h=27ff5d37a3457fd32db4708b8f2fe9df9b645885;hb=3bdcf490c99abda52aea5346fddb6f9f6c43bb2c;hp=55e6a4e6a3bc6423d92c02517b3f64a193e1a416;hpb=5cd600fa91ca3940bafce0ab5f5ff0372ca8388e;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm index 55e6a4e..27ff5d3 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm @@ -7,9 +7,9 @@ use base qw/ DBIx::Class::Schema::Loader::DBI /; use Carp::Clan qw/^DBIx::Class/; -use Class::C3; +use mro 'c3'; -our $VERSION = '0.07000'; +our $VERSION = '0.07008'; =head1 NAME @@ -71,7 +71,16 @@ sub _tables_list { if $table =~ /\A(\w+)\z/; } - return $self->_filter_tables(\@tables, $opts); + { + # 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/; + }; + + return $self->_filter_tables(\@tables, $opts); + } } sub _table_columns { @@ -112,6 +121,33 @@ sub _table_uniq_info { return \@uniqs; } +sub _table_comment { + my ( $self, $table ) = @_; + my ($table_comment) = $self->schema->storage->dbh->selectrow_array( + q{ + SELECT comments FROM all_tab_comments + WHERE owner = ? + AND table_name = ? + AND table_type = 'TABLE' + }, undef, $self->db_schema, $self->_uc($table) + ); + + return $table_comment +} + +sub _column_comment { + my ( $self, $table, $column_number, $column_name ) = @_; + my ($column_comment) = $self->schema->storage->dbh->selectrow_array( + q{ + SELECT comments FROM all_col_comments + WHERE owner = ? + AND table_name = ? + AND column_name = ? + }, undef, $self->db_schema, $self->_uc( $table ), $self->_uc( $column_name ) + ); + return $column_comment +} + sub _table_pk_info { my ($self, $table) = (shift, shift); @@ -156,10 +192,11 @@ AND upper(trigger_type) LIKE '%BEFORE EACH ROW%' AND lower(triggering_event) LIK $result->{$col_name}{is_auto_increment} = 1; - if (my ($seq_name) = $trigger_body =~ /"?(\w+)"?\.nextval/i) { - $seq_name = $self->_lc($seq_name); + if (my ($seq_schema, $seq_name) = $trigger_body =~ /(?:\."?(\w+)"?)?"?(\w+)"?\.nextval/i) { + $seq_schema = $self->_lc($seq_schema || $self->db_schema); + $seq_name = $self->_lc($seq_name); - $result->{$col_name}{sequence} = $seq_name; + $result->{$col_name}{sequence} = ($self->qualify_objects ? ($seq_schema . '.') : '') . $seq_name; } }