X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FOracle%2FGeneric.pm;h=4d8b781105f1a3bf8012538df530f3a10165d9ce;hb=720448921cee676e52ed7e7b37c17352ea9b8470;hp=87e5b0533cd077ccd56e2773979470d113fde184;hpb=ea8d89387cd3e55447ed76c3898a682a0b7854f5;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index 87e5b05..4d8b781 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI::Oracle::Generic; use strict; use warnings; use Scope::Guard (); -use Context::Preserve (); +use Context::Preserve 'preserve_context'; use Try::Tiny; use namespace::clean; @@ -88,9 +88,13 @@ sub deployment_statements { $sqltargs->{quote_table_names} = $quote_char ? 1 : 0; $sqltargs->{quote_field_names} = $quote_char ? 1 : 0; - my $oracle_version = try { $self->_get_dbh->get_info(18) }; - - $sqltargs->{producer_args}{oracle_version} = $oracle_version; + if ( + ! exists $sqltargs->{producer_args}{oracle_version} + and + my $dver = $self->_server_info->{dbms_version} + ) { + $sqltargs->{producer_args}{oracle_version} = $dver; + } $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest); } @@ -130,7 +134,7 @@ sub _dbh_get_autoinc_seq { my ( $schema, $table ) = $source_name =~ /(\w+)\.(\w+)/; my ($sql, @bind) = $sql_maker->select ( 'ALL_TRIGGERS', - ['trigger_body'], + ['trigger_body', 'table_owner'], { $schema ? (owner => $schema) : (), table_name => $table || $source_name, @@ -141,10 +145,18 @@ sub _dbh_get_autoinc_seq { my $sth = $dbh->prepare($sql); $sth->execute (@bind); - while (my ($insert_trigger) = $sth->fetchrow_array) { - return $1 if $insert_trigger =~ m!("?\w+"?)\.nextval!i; # col name goes here??? + while (my ($insert_trigger, $schema) = $sth->fetchrow_array) { + my ($seq_name) = $insert_trigger =~ m!("?[.\w"]+"?)\.nextval!i; + + next unless $seq_name; + + if ($seq_name !~ /\./) { + $seq_name = join '.' => $schema, $seq_name; + } + + return $seq_name; } - $self->throw_exception("Unable to find a sequence INSERT trigger on table '$source_name'."); + $self->throw_exception("Unable to find a sequence %INSERT% trigger on table '$source_name'."); } sub _sequence_fetch { @@ -362,25 +374,7 @@ sub relname_to_table_alias { my $alias = $self->next::method(@_); - return $alias if length($alias) <= 30; - - # get a base64 md5 of the alias with join_count - require Digest::MD5; - my $ctx = Digest::MD5->new; - $ctx->add($alias); - my $md5 = $ctx->b64digest; - - # remove alignment mark just in case - $md5 =~ s/=*\z//; - - # truncate and prepend to truncated relname without vowels - (my $devoweled = $relname) =~ s/[aeiou]//g; - my $shortened = substr($devoweled, 0, 18); - - my $new_alias = - $shortened . '_' . substr($md5, 0, 30 - length($shortened) - 1); - - return $new_alias; + return $self->sql_maker->_shorten_identifier($alias, [$relname]); } =head2 with_deferred_fk_checks @@ -408,8 +402,8 @@ sub with_deferred_fk_checks { $self->_do_query('alter session set constraints = immediate'); }); - return Context::Preserve::preserve_context(sub { $sub->() }, - after => sub { $txn_scope_guard->commit }); + return + preserve_context { $sub->() } after => sub { $txn_scope_guard->commit }; } =head1 ATTRIBUTES