X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FOracle.pm;h=84f801f7e7de8d33b1055067d34e838b576c335e;hb=f671b6308c4f2210255b2eaa12fc47a49621d436;hp=b9612df7db91dfdb5f953613c43d2579b0ba6c10;hpb=760fd65c04b63c468e699dfd2f50bff7f6638a36;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 b9612df..84f801f 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.07002'; =head1 NAME @@ -40,6 +40,10 @@ sub _setup { if (not defined $self->preserve_case) { $self->preserve_case(0); } + elsif ($self->preserve_case) { + $self->schema->storage->sql_maker->quote_char('"'); + $self->schema->storage->sql_maker->name_sep('.'); + } } sub _table_as_sql { @@ -62,12 +66,21 @@ sub _tables_list { $table =~ s/\w+\.//; next if $table eq 'PLAN_TABLE'; - $table = lc $table; + $table = $self->_lc($table); push @tables, $1 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 { @@ -75,8 +88,9 @@ sub _table_columns { my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->column_info(undef, $self->db_schema, uc $table, '%'); - return [ map lc($_->{COLUMN_NAME}), @{ $sth->fetchall_arrayref({ COLUMN_NAME => 1 }) || [] } ]; + my $sth = $dbh->column_info(undef, $self->db_schema, $self->_uc($table), '%'); + + return [ map $self->_lc($_->{COLUMN_NAME}), @{ $sth->fetchall_arrayref({ COLUMN_NAME => 1 }) || [] } ]; } sub _table_uniq_info { @@ -93,14 +107,14 @@ sub _table_uniq_info { }, {}, 1); - $sth->execute(uc $table,$self->{db_schema} ); + $sth->execute($self->_uc($table),$self->{db_schema} ); my %constr_names; while(my $constr = $sth->fetchrow_arrayref) { - my $constr_name = lc $constr->[0]; - my $constr_def = lc $constr->[1]; + my $constr_name = $self->_lc($constr->[0]); + my $constr_col = $self->_lc($constr->[1]); $constr_name =~ s/\Q$self->{_quoter}\E//; - $constr_def =~ s/\Q$self->{_quoter}\E//; - push @{$constr_names{$constr_name}}, $constr_def; + $constr_col =~ s/\Q$self->{_quoter}\E//; + push @{$constr_names{$constr_name}}, $constr_col; } my @uniqs = map { [ $_ => $constr_names{$_} ] } keys %constr_names; @@ -108,17 +122,18 @@ sub _table_uniq_info { } sub _table_pk_info { - my ($self, $table) = @_; - return $self->next::method(uc $table); + my ($self, $table) = (shift, shift); + + return $self->next::method($self->_uc($table), @_); } sub _table_fk_info { - my ($self, $table) = @_; + my ($self, $table) = (shift, shift); - my $rels = $self->next::method(uc $table); + my $rels = $self->next::method($self->_uc($table), @_); foreach my $rel (@$rels) { - $rel->{remote_table} = lc $rel->{remote_table}; + $rel->{remote_table} = $self->_lc($rel->{remote_table}); } return $rels; @@ -127,12 +142,15 @@ sub _table_fk_info { sub _columns_info_for { my ($self, $table) = (shift, shift); - my $result = $self->next::method(uc $table, @_); + my $result = $self->next::method($self->_uc($table), @_); my $dbh = $self->schema->storage->dbh; + local $dbh->{LongReadLen} = 100000; + local $dbh->{LongTruncOk} = 1; + my $sth = $dbh->prepare_cached(q{ -SELECT atc.column_name +SELECT atc.column_name, ut.trigger_body FROM all_triggers ut JOIN all_trigger_cols atc USING (trigger_name) WHERE atc.table_name = ? @@ -140,10 +158,19 @@ AND lower(column_usage) LIKE '%new%' AND lower(column_usage) LIKE '%out%' AND upper(trigger_type) LIKE '%BEFORE EACH ROW%' AND lower(triggering_event) LIKE '%insert%' }, {}, 1); - $sth->execute(uc $table); + $sth->execute($self->_uc($table)); + + while (my ($col_name, $trigger_body) = $sth->fetchrow_array) { + $col_name = $self->_lc($col_name); + + $result->{$col_name}{is_auto_increment} = 1; - while (my ($col_name) = $sth->fetchrow_array) { - $result->{lc $col_name}{is_auto_increment} = 1; + 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} = ($self->qualify_objects ? ($seq_schema . '.') : '') . $seq_name; + } } while (my ($col, $info) = each %$result) { @@ -157,9 +184,12 @@ AND upper(trigger_type) LIKE '%BEFORE EACH ROW%' AND lower(triggering_event) LIK $info->{size} = $info->{size} / 2; } elsif (lc($info->{data_type}) eq 'number') { - $info->{data_type} = 'numeric'; + $info->{original}{data_type} = 'number'; + $info->{data_type} = 'numeric'; if (eval { $info->{size}[0] == 38 && $info->{size}[1] == 0 }) { + $info->{original}{size} = $info->{size}; + $info->{data_type} = 'integer'; delete $info->{size}; } @@ -194,12 +224,40 @@ AND upper(trigger_type) LIKE '%BEFORE EACH ROW%' AND lower(triggering_event) LIK $info->{size} = [ $day_precision, $second_precision ]; } } + elsif (lc($info->{data_type}) eq 'float') { + $info->{original}{data_type} = 'float'; + $info->{original}{size} = $info->{size}; + + if ($info->{size} <= 63) { + $info->{data_type} = 'real'; + } + else { + $info->{data_type} = 'double precision'; + } + delete $info->{size}; + } elsif (lc($info->{data_type}) eq 'urowid' && $info->{size} == 4000) { delete $info->{size}; } - - if (eval { lc(${ $info->{default_value} }) eq 'sysdate' }) { - ${ $info->{default_value} } = 'current_timestamp'; + elsif (lc($info->{data_type}) eq 'date') { + $info->{data_type} = 'datetime'; + $info->{original}{data_type} = 'date'; + } + elsif (lc($info->{data_type}) eq 'binary_float') { + $info->{data_type} = 'real'; + $info->{original}{data_type} = 'binary_float'; + } + elsif (lc($info->{data_type}) eq 'binary_double') { + $info->{data_type} = 'double precision'; + $info->{original}{data_type} = 'binary_double'; + } + + if ((eval { lc(${ $info->{default_value} }) }||'') eq 'sysdate') { + my $current_timestamp = 'current_timestamp'; + $info->{default_value} = \$current_timestamp; + + my $sysdate = 'sysdate'; + $info->{original}{default_value} = \$sysdate; } }