X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FOracle%2FGeneric.pm;h=87e5b0533cd077ccd56e2773979470d113fde184;hb=ea8d89387cd3e55447ed76c3898a682a0b7854f5;hp=95e428db515df99da9917e4a8de007fb953ff36f;hpb=25ca709b095f6f33043eaf056b34720f2334a04d;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index 95e428d..87e5b05 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -4,6 +4,8 @@ use strict; use warnings; use Scope::Guard (); use Context::Preserve (); +use Try::Tiny; +use namespace::clean; =head1 NAME @@ -86,7 +88,7 @@ sub deployment_statements { $sqltargs->{quote_table_names} = $quote_char ? 1 : 0; $sqltargs->{quote_field_names} = $quote_char ? 1 : 0; - my $oracle_version = eval { $self->_get_dbh->get_info(18) }; + my $oracle_version = try { $self->_get_dbh->get_info(18) }; $sqltargs->{producer_args}{oracle_version} = $oracle_version; @@ -132,7 +134,7 @@ sub _dbh_get_autoinc_seq { { $schema ? (owner => $schema) : (), table_name => $table || $source_name, - triggering_event => 'INSERT', + triggering_event => { -like => '%INSERT%' }, status => 'ENABLED', }, ); @@ -157,46 +159,53 @@ sub _ping { my $dbh = $self->_dbh or return 0; local $dbh->{RaiseError} = 1; + local $dbh->{PrintError} = 0; - eval { - $dbh->do("select 1 from dual"); + return try { + $dbh->do('select 1 from dual'); + 1; + } catch { + 0; }; - - return $@ ? 0 : 1; } sub _dbh_execute { my $self = shift; my ($dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_; - my $wantarray = wantarray; - - my (@res, $exception, $retried); - - RETRY: { - do { - eval { - if ($wantarray) { - @res = $self->next::method(@_); - } else { - $res[0] = $self->next::method(@_); - } - }; - $exception = $@; - if ($exception =~ /ORA-01003/) { + my (@res, $tried); + my $wantarray = wantarray(); + my $next = $self->next::can; + do { + try { + my $exec = sub { $self->$next($dbh, $op, $extra_bind, $ident, $bind_attributes, @args) }; + + if (!defined $wantarray) { + $exec->(); + } + elsif (! $wantarray) { + $res[0] = $exec->(); + } + else { + @res = $exec->(); + } + + $tried++; + } + catch { + if (! $tried and $_ =~ /ORA-01003/) { # ORA-01003: no statement parsed (someone changed the table somehow, # invalidating your cursor.) my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args); delete $dbh->{CachedKids}{$sql}; - } else { - last RETRY; } - } while (not $retried++); - } - - $self->throw_exception($exception) if $exception; + else { + $self->throw_exception($_); + } + }; + } while (! $tried++); - $wantarray ? @res : $res[0] + return $wantarray ? @res : $res[0]; } =head2 get_autoinc_seq @@ -211,19 +220,6 @@ sub get_autoinc_seq { $self->dbh_do('_dbh_get_autoinc_seq', $source, $col); } -=head2 columns_info_for - -This wraps the superclass version of this method to force table -names to uppercase - -=cut - -sub columns_info_for { - my ($self, $table) = @_; - - $self->next::method($table); -} - =head2 datetime_parser_type This sets the proper DateTime::Format module for use with @@ -239,10 +235,10 @@ Used as: on_connect_call => 'datetime_setup' -In L to set the session nls date, and -timestamp values for use with L and the -necessary environment variables for L, which is used -by it. +In L to set the session nls +date, and timestamp values for use with L +and the necessary environment variables for L, which +is used by it. Maximum allowable precision is used, unless the environment variables have already been set. @@ -416,28 +412,11 @@ sub with_deferred_fk_checks { after => sub { $txn_scope_guard->commit }); } -sub _select_args { - my ($self, $ident, $select, $where, $attrs) = @_; - - my $connect_by_args = {}; - if ( $attrs->{connect_by} || $attrs->{start_with} || $attrs->{order_siblings_by} ) { - $connect_by_args = { - connect_by => $attrs->{connect_by}, - start_with => $attrs->{start_with}, - order_siblings_by => $attrs->{order_siblings_by}, - } - } - - my @rv = $self->next::method($ident, $select, $where, $attrs); - - return (@rv, $connect_by_args); -} - =head1 ATTRIBUTES Following additional attributes can be used in resultsets. -=head2 connect_by +=head2 connect_by or connect_by_nocycle =over 4 @@ -448,6 +427,7 @@ Following additional attributes can be used in resultsets. A hashref of conditions used to specify the relationship between parent rows and child rows of the hierarchy. + connect_by => { parentid => 'prior personid' } # adds a connect by statement to the query: @@ -457,6 +437,18 @@ and child rows of the hierarchy. # person me # CONNECT BY # parentid = prior persionid + + + connect_by_nocycle => { parentid => 'prior personid' } + + # adds a connect by statement to the query: + # SELECT + # me.persionid me.firstname, me.lastname, me.parentid + # FROM + # person me + # CONNECT BY NOCYCLE + # parentid = prior persionid + =head2 start_with