—
—

              
# Additional methods for DBI.
package UR::DBI;
HideShow 22 lines of Pod
=pod
=head1 NAME
UR::DBI - methods for interacting with a database.
=head1 SYNOPSIS
    ##- use UR::DBI;
    UR::DBI->monitor_sql(1);
    my $dbh = UR::DBI->connect(...);
=head1 DESCRIPTION
This module subclasses DBI, and provides a few extra methods useful when using a database.
=head1 METHODS
=over 4
=cut
# set up package
require 5.006_000;
use warnings;
use strict;
our $VERSION = "0.30"; # UR $VERSION;;
# set up module
use base qw(Exporter DBI);
our (@EXPORT, @EXPORT_OK);
@EXPORT = qw();
@EXPORT_OK = qw();
use IO::Handle;
use IO::File;
use Time::HiRes;
# do not use UR::ModuleBase as base class because it does not play nice with DBI
#
# UR::DBI control flags
#
# Build a few class methods to manipulate the environment variables
# that control SQL monitoring
my %sub_env_map = ( monitor_sql => 'UR_DBI_MONITOR_SQL',
                    monitor_dml => 'UR_DBI_MONITOR_DML',
                    explain_sql_if => 'UR_DBI_EXPLAIN_SQL_IF',
                    explain_sql_slow => 'UR_DBI_EXPLAIN_SQL_SLOW',
                    explain_sql_match => 'UR_DBI_EXPLAIN_SQL_MATCH',
                    explain_sql_callstack => 'UR_DBI_EXPLAIN_SQL_CALLSTACK',
                    no_commit => 'UR_DBI_NO_COMMIT',
                    monitor_every_fetch => 'UR_DBI_MONITOR_EVERY_FETCH',
                    dump_stack_on_connect => 'UR_DBI_DUMP_STACK_ON_CONNECT',
                  );
our ($monitor_sql,$monitor_dml,$no_commit,$monitor_every_fetch,$dump_stack_on_connect,
    $explain_sql_slow,$explain_sql_if,$explain_sql_match,$explain_sql_callstack);
while ( my($subname, $envname) = each ( %sub_env_map ) ) {
    no strict 'refs';
    # There's a scalar of the same name as the sub to hold the value, hook them together
    *{$subname} = \$ENV{$envname};
    my $subref = sub {
                      if (@_ > 1) {
                          $$subname = $_[1];
                      }
                      return $$subname;
                  };
    if ($subname =~ /explain/) {
        eval "\$$subname = '' if not defined \$$subname";
    }
    else {
        eval "\$$subname = 0 if not defined \$$subname";
    }
    die $@ if $@;
    *$subname = $subref;
}
# by default, monitored SQL goes to STDOUT
# FIXME change this 'our' back to a 'my' after we're transisitioned off of the old App API
our $sql_fh = IO::Handle->new;
$sql_fh->fdopen(fileno(STDERR), 'w');
$sql_fh->autoflush(1);
sub sql_fh
{
    $sql_fh = $_[1] if @_ > 1;
    return $sql_fh;
}
#
# Logging methods
#
our $log_file;
sub log_file {
    $log_file = pop if @_ > 1;
    return $log_file;
}
our $log_fh;
my $create_time=0;
sub start_logging {
    return 1 if(defined($log_fh));
    return 0 if(-e "$log_file");
    $log_fh = new IO::File("> ${log_file}");
    unless(defined($log_fh)) {
           warn "Logging File $log_file Could not be created\n";
           return 0;
    }
    $create_time=Time::HiRes::time();
    return 1;
}
sub stop_logging {
    return 1 unless(defined($log_fh));
    $log_fh->close;
    undef $log_fh;
}
sub log_sql {
    return 1 unless(defined($log_fh));
    my $sql=pop;
    my $no_timestamp=pop;
    print $log_fh '=' x 10, "\n" unless($no_timestamp);
    print $log_fh Time::HiRes::time()-$create_time, "\n" unless($no_timestamp);
    print $log_fh $sql;
}
#
# Standard DBI overrides
# 
sub connect
{
    my $self = shift;
    my @params = @_;
    if ($monitor_sql or $dump_stack_on_connect) {
        my $time = time;
        my $time_string = join(' ', $time, '[' . localtime($time) . ']');
        $sql_fh->print("DB CONNECT AT: $time_string");    
    }
    if ($dump_stack_on_connect) {
        $sql_fh->print(Carp::longmess());
    }
     
    $params[2] = 'xxx';
    # Param 3 is usually a hashref of connection modifiers
    if (ref($params[3]) and ref($params[3]) =~ m/HASH/) {
        my $string = join(', ',
                          map { $_ . ' => ' . $params[3]->{$_} }
                              keys(%{$params[3]})
                         );
        $params[3] = "{ $string }";
    }
         
    my $params_stringified = join(",", map { defined($_) ? "'$_'" : 'undef' } @params);  
    UR::DBI::before_execute("connecting with params: ($params_stringified)");
     
    my $rv = $self->SUPER::connect(@_);
    UR::DBI::after_execute();
    return $rv;
}
#
# UR::Object hooks
#
sub commit_all_app_db_objects {
    my $this_class = shift;
    my $handle = shift;
         
    my $data_source;
    if ($handle->isa("UR::DBI::db")) {
        $data_source = UR::DataSource::RDBMS->get_for_dbh($handle);
    }
    elsif ($handle->isa("UR::DBI::st")) {
        $data_source = UR::DataSource::RDBMS->get_for_dbh($handle->{Database});
    }
    else {
        Carp::confess("No handle passed to method!?")
    }
     
    unless ($data_source) {
        return;
    }
    return $data_source->_set_all_objects_saved_committed();
}
sub rollback_all_app_db_objects {
    my $this_class = shift;
    my $handle = shift;
     
    my $data_source;
    if ($handle->isa("UR::DBI::db")) {
        $data_source = UR::DataSource::RDBMS->get_for_dbh($handle);
    }
    elsif ($handle->isa("UR::DBI::st")) {
        $data_source = UR::DataSource::RDBMS->get_for_dbh($handle->{Database});
    }
    else {
        Carp::confess("No handle passed to method!?")
    }
     
    unless ($data_source) {
        Carp::confess("No data source found for database handle! $handle")
    }
     
    return $data_source->_set_all_objects_saved_rolled_back();         
}
my @disable_dump_and_explain;
sub _disable_dump_explain 
{
    push @disable_dump_and_explain,
        [$monitor_sql,$explain_sql_slow,$explain_sql_match];
    $monitor_sql = 0;
    $explain_sql_slow = '';
    $explain_sql_match = '';
}
sub _restore_dump_explain 
{
    if (@disable_dump_and_explain) {
        my $vars = pop @disable_dump_and_explain;
        ($monitor_sql,$explain_sql_slow,$explain_sql_match) = @$vars;
    }
    else {
        Carp::confess("No state saved for disabled dump/explain");
    }
}
# The before_execute/after_execute subroutine pair
# are callbacks called by execute() and by other 
# methods which implicitly execute a statement.
# They use these three varaibles to track state,
# presuming that the callback pair cannot be nested. <!!
our ($start_time, $elapsed_time);
# This gets around a bug which prevents variables 
# which are strings internally utf8 encoded from working with DBI
# as execution parameters.
if ($^O eq "MSWin32" || $^O eq 'cygwin') {
    *normalize_parameter = sub { $_[0] = substr($_[0],0) };
}
elsif ($^V le v5.8.0) {
    # perl 5.6.1 utf8 module does not have a downgrade function
    *normalize_parameter = sub { $_[0] = substr($_[0],0) };
}
else {
    require utf8;
    *normalize_parameter = \&utf8::downgrade;
}
sub before_execute
{
    #my ($dbh,$sql,@params) = @_;
    # $dbh is optional
     
    my $dbh;
    $dbh = shift if ref($_[0]);
     
    my $sql = shift;
    # Odd errors occur sometimes with values which have not gone through
    # updgrade, downgrade or $_ = substr($_,0).  The query fails w/o error.
    # This has some connection to a language/encoding problem, and has so
    # far only been seen with Tk, Gtk2, and XML parser derived data.
    # Note: when this error occurs it happens with a seeminly normal Perl variable.
    for (@_) {
        normalize_parameter($_);
    }
     
    if ($dbh and length($explain_sql_match)) {
        for my $val ($sql,@_) {
            if ($val =~ /$explain_sql_match/gi) {                
                $sql_fh->print("\nEXPLAIN QUERY MATCHING /$explain_sql_match/gi"
                    . ($val ne $sql ? " (on value '$val') " : "")                    
                );
                if ($monitor_sql) {
                    $sql_fh->print("\n");
                }
                else {
                    _print_sql_and_params($sql,@_);
                }                
                if ($explain_sql_callstack) {
                    $sql_fh->print(Carp::longmess("callstack begins"),"\n");
                }
                if ($UR::DBI::explained_queries{$sql}) {
                    $sql_fh->print("(query explained above)\n");
                }
                else {
                    UR::DBI::_print_query_plan($sql,$dbh);
                    $UR::DBI::explained_queries{$sql} = 1;
                }
                last;
            }
        }
    }
     
    my $start_time = _set_start_time();
    if ($monitor_sql){
        _print_sql_and_params($sql,@_);
        if ($monitor_sql > 1) {
            $sql_fh->print(Carp::longmess("callstack begins"),"\n");
        }
        _print_monitor_label("EXECUTE");        
    }
    elsif($monitor_dml && $sql !~ /^\s*select/i){
        _print_sql_and_params($sql,@_);
        _print_monitor_label("EXECUTE");        
        $monitor_dml=2;
    }
    no warnings;            
    my $log_sql_str = _generate_sql_and_params_log_entry($sql, @_);
    UR::DBI::log_sql($log_sql_str);
    return $start_time;
}
sub after_execute
{    
    #my ($sql,@params) = @_;
    my $elapsed_time = _set_elapsed_time();
    if ($monitor_sql){
        _print_elapsed_time();
    }
    elsif($monitor_dml == 2){
        _print_elapsed_time();
        $monitor_dml = 1;
    }
    UR::DBI::log_sql(1, ($elapsed_time)."\n");
    return $elapsed_time;
}
# The before_fetch/after_fetch pair are callback
# called by fetch() and by other methods which implicitly
# fetch data w/o explicitly calling fetch().
our $_fetching = 0;
sub before_fetch {
    my $sth = shift;
    return if @disable_dump_and_explain;
    if ($_fetching) {        
        Carp::cluck("before_fetch called after another before_fetch w/o intervening after_fetch!");
    }
    $_fetching = 1;
    my $fetch_timing_arrayref = $sth->fetch_timing_arrayref;
    if ($monitor_sql) {
        if ($fetch_timing_arrayref and @$fetch_timing_arrayref == 0) {
            UR::DBI::_print_monitor_label('FIRST FETCH');
        }
        elsif ($monitor_every_fetch) {
            UR::DBI::_print_monitor_label('NTH FETCH');
        }
    }
    return UR::DBI::_set_start_time();
}
sub after_fetch {
    my $sth = shift;
    return if @disable_dump_and_explain;
    $_fetching = 0;
    my $fetch_timing_arrayref = $sth->fetch_timing_arrayref;
    my $time;
    push @$fetch_timing_arrayref, UR::DBI::_set_elapsed_time();
    if ($monitor_sql) {
        if ($monitor_every_fetch || @$fetch_timing_arrayref == 1) {
            $time = UR::DBI::_print_elapsed_time();
        }
    }
    if (@$fetch_timing_arrayref == 1) {
        my $time = $sth->execute_time + $fetch_timing_arrayref->[0];
        UR::DBI::_check_query_timing($sth->{Statement},$time,$sth->{Database},$sth->last_params);
    }
    return $time;
}
sub after_all_fetches_with_sth {
    my $sth = shift;
     
    my $fetch_timing_arrayref = $sth->fetch_timing_arrayref;
     
    # This arrayref is set when it goes through the subclass' execute(),
    # and is removed when we finish all fetches().  
     
    # Since a variety of things attempt to call this from the various "final" 
    # positions of an $sth we delete this so the final callback operates only once.
    # Also, internally generated $sths which do not get executed() normally
    # will be skipped by this check.
     
    if (!$fetch_timing_arrayref) {
        # internal sth which did not go through prepare()
        #print $sql_fh "SKIP STH\n";
        return;
    }
    $sth->fetch_timing_arrayref(undef);
     
    my $print_fetch_summary;
    if ($monitor_sql and $sth->{Statement} =~ /select/i) {
        $print_fetch_summary = 1;
        UR::DBI::_print_monitor_label('TOTAL EXECUTE-FETCH');
    }
     
    my $time = $sth->execute_time;    
     
    if (@$fetch_timing_arrayref) {
        for my $fetch_time (@$fetch_timing_arrayref ) {
            $time += $fetch_time;
        }
        if ($print_fetch_summary) {
            UR::DBI::_print_monitor_time($time);    
        }
        # since there WERE fetches, we already checked query timing
    }
    else {
        if ($print_fetch_summary) {
            UR::DBI::_print_monitor_time($time);
        }
        # since there were NOT fetches, we check query timing now
        UR::DBI::_check_query_timing($sth->{Statement},$time,$sth->{Database},$sth->last_params);
    }
    return $time;
}
sub after_all_fetches_no_sth {
    my ($sql, $time, $dbh, @params) = @_;
    $time = _set_elapsed_time() unless defined $time;
    if ($monitor_sql and $sql =~ /select/i) {
        UR::DBI::_print_monitor_label('TOTAL EXECUTE-FETCH');
        UR::DBI::_print_monitor_time($time);
    }
    # no sth = no fetches = no query timing check done yet...
    UR::DBI::_check_query_timing($sql,$time,$dbh,@params);
    return $time;
}
# These methods are called by the above.
sub _generate_sql_and_params_log_entry 
{
    my $sql = shift;
    no warnings;
    my $sql_log_str =  "\nSQL: $sql\n"; 
    if (@_) {
        $sql_log_str .= "PARAMS: ";
        $sql_log_str .= join(", ",
                              map { defined($_) ? "'$_'" : "NULL" }
                              map { scalar(grep { $_ } map { 128 & ord $_ } split(//, substr($_, 0, 64))) ? '<BLOBISH>' : $_  }
                              @_ )
                        . "\n";
    }
    return $sql_log_str;
}
sub _print_sql_and_params 
{
    my $sql = shift;
    my $entry = _generate_sql_and_params_log_entry($sql, @_);
    no warnings;
    print $sql_fh $entry;
}
sub _set_start_time 
{
    $start_time=&Time::HiRes::time();
}
our $_print_monitor_label_or_time_is_ready_for = "label";
sub _print_monitor_label 
{
    #Carp::cluck() unless $_print_monitor_label_or_time_is_ready_for eq "label";    
    my $time_label = shift;
    $sql_fh->print("$time_label TIME: ");    
    $_print_monitor_label_or_time_is_ready_for = "time";
}
sub _print_monitor_time 
{
    #Carp::cluck() unless $_print_monitor_label_or_time_is_ready_for eq "time";
    $sql_fh->printf( "%.4f s\n", shift);
    $_print_monitor_label_or_time_is_ready_for = "label";
}
sub _set_elapsed_time
{
    $elapsed_time = &Time::HiRes::time()-$start_time;
}
sub _print_elapsed_time 
{
    _print_monitor_time($elapsed_time);
}
our $_print_check_for_slow_query = 0;
sub _check_query_timing 
{
    my ($sql,$time,$dbh,@params) = @_;
    return if @disable_dump_and_explain;
    return unless $sql =~ /select/i;
    print $sql_fh "CHECK FOR SLOW QUERY:\n" if $_print_check_for_slow_query; # used only by a test case
    if (length($explain_sql_slow) and $time >= $explain_sql_slow) {        
        $sql_fh->print("EXPLAIN QUERY SLOWER THAN $explain_sql_slow seconds ($time):");
        if ($monitor_sql
        || ($monitor_dml && $sql !~ /^\s*select/i)) {        
            $sql_fh->print("\n");
        }
        else {
            _print_sql_and_params($sql,@params);
        }
        if ($explain_sql_callstack) {
            $sql_fh->print(Carp::longmess("callstack begins"),"\n");
        }
        if ($UR::DBI::explained_queries{$sql}) {
            $sql_fh->print("(query explained above)\n");
        } 
        else {
            $UR::DBI::explained_queries{$sql} = 1;
            UR::DBI::_print_query_plan($sql,$dbh);
        }
    }
}
sub _print_query_plan
{    
    my ($sql,$dbh,%params) = @_;
    UR::DBI::_disable_dump_explain();
    $dbh->do($UR::DBI::EXPLAIN_PLAN_CLEANUP_DML);
     
    # placeholders in explain plan queries on windows
    # results in Oracle throwing an ORA-00600 error, 
    # likely due to interaction with DBI.  Replace with
    # literals.
    if ($^O eq "MSWin32" || $^O eq 'cygwin') {
        $sql =~ s/\?/'1'/g;
    }
     
    $dbh->do($UR::DBI::EXPLAIN_PLAN_DML . "\n" . $sql)
        or die "Failed to produce query plan! " . $dbh->errstr;        
    UR::Report->generate(
        sql => [$UR::DBI::EXPLAIN_PLAN_SQL],
        dbh => $dbh,
        count => 0,
        outfh => $sql_fh,
        %params,
        "explain-sql" => 0,
        "echo" => 0,
    );
    $sql_fh->print("\n");
    $dbh->do($UR::DBI::EXPLAIN_PLAN_CLEANUP_DML);                
    UR::DBI::_restore_dump_explain();
     
    return 1;
}
############
#
# Database handle subclass
#
############
package UR::DBI::db;
use strict;
use warnings;
our @ISA = qw(DBI::db);
sub commit
{
    my $self = shift;        
#    unless ($no_commit) {
#        print "\n\n\n************* FORCIBLY SETTING NO-COMMIT FOR TESTING.  This would have committeed!!!! **********\n\n\n";
#        $no_commit = 1;
#    }
     
    if ($no_commit) 
    {
        # Respect the ->no_commit(1) setting.
        UR::DBI::before_execute("commit (ignored)");        
        UR::DBI::after_execute;        
        return 1;
    }
    else 
    {
        if(UR::DataSource->use_dummy_autogenerated_ids) {
            # Not cool...you shouldn't have dummy-ids on and no-commit off
            # Don't commit, and notify the authorities
            UR::DBI::before_execute("commit (ignored)");
            $UR::Context::current->error_message('Tried to commit with dummy-ids on and no-commit off');
            UR::DBI::after_execute;
            #$UR::Context::current->send_email(
            #    To => 'example@example.edu',
            #    Subject => 'attempt to commit with dummy-ids on and no-commit off '.
            #                "by $ENV{USER} on $ENV{HOST} running ".
            #                UR::Context::Process->original_program_path." as pid $$",
            #    Message => "Call stack:\n" .Carp::longmess()
            #);
        } else {
            # Commit and update the associated objects.
            UR::DBI::before_execute("commit");        
            my $rv = $self->SUPER::commit(@_);
            UR::DBI::after_execute;        
            if ($rv) {
                UR::DBI->commit_all_app_db_objects($self)
            }
            return $rv;
        }
    }
}
sub commit_without_object_update 
{ 
    UR::DBI::before_execute("commit (no object updates)");
    my $rv = shift->SUPER::commit(@_); 
    UR::DBI::after_execute();
    return $rv;
}
sub rollback
{
    my $self = shift;
    UR::DBI::before_execute("rollback");
    my $rv = $self->SUPER::rollback(@_);
    UR::DBI::after_execute();
    if ($rv) {
        UR::DBI->rollback_all_app_db_objects($self)
    }
    return $rv;
}
sub rollback_without_object_update 
{ 
    UR::DBI::before_execute("rollback (w/o object updates)");
    my $rv = shift->SUPER::commit(@_);
    UR::DBI::after_execute();
    return $rv;
}
sub disconnect
{
    my $self = shift;
     
    # Always rollback.  Oracle commits by default on disconnect.
    $self->rollback;    
     
    # Msg and disconnect.
    UR::DBI::before_execute("disconnecting");
    $self->SUPER::disconnect(@_);
    UR::DBI::after_execute();
     
    # There doesn't seem to be anything less which
    # sets this, but legacy tools did
    if (
        (defined $UR::DBI::common_dbh)
        and
        ($self eq $UR::DBI::common_dbh)
       )
    {
        UR::DBI::before_execute("common dbh removed");
        $UR::DBI::common_dbh = undef;
        UR::DBI::after_execute("common dbh removed");
    }
}
sub prepare
{
    my $self = shift;
    my $sql = $_[0];        
    my $sth;
     
    #print $sql_fh "PREPARE: $sql\n";
     
    if ($sql =~ /^\s*(commit|rollback)\s*$/i)
    {
        unless ($sql =~ /^(commit|rollback)$/i) {
            Carp::confess("Executing a statement with an embedded commit/rollback?\n$sql\n");
        }
         
        if ($sth = $self->SUPER::prepare(@_))
        {            
            if ($1 =~ /commit/i)
            {
                $UR::DBI::prepared_commit{$sth} = 1;
            }
            elsif ($1 =~  /rollback/)
            {
                $UR::DBI::prepared_rollback{$sth} = 1;
            }
        }
    }    
    else
    {
        $sth = $self->SUPER::prepare(@_) or return;
    }
         
    return $sth;
}
# For newer versions of DBI, some of the $dbh->select* methods do not
# call execute internally, so SQL dumping and logging will not occur.
# These are listed below, and the bad ones are overridden.
# selectall_hashref ok
# selectcol_arrayref ok
# selectrow_hashref ok 
# selectall_arrayref bad
# selectrow_arrayref bad
# selectrow_array bad
sub selectall_arrayref
{
    my $self = shift;
    my @p = ($_[0],@_[2..$#_]);    
    UR::DBI::before_execute($self,@p);
    my $ar = $self->SUPER::selectall_arrayref(@_);
    my $time = UR::DBI::after_execute($self,@p);
    UR::DBI::after_all_fetches_no_sth($_[0],$time,$self,@p);
    return $ar;
}
sub selectcol_arrayref
{
    my $self = shift;
    my @p = ($_[0],@_[2..$#_]);    
    UR::DBI::before_execute($self,@p);
    UR::DBI::_disable_dump_explain();
    my $ar = $self->SUPER::selectcol_arrayref(@_);
    UR::DBI::_restore_dump_explain();
    my $time = UR::DBI::after_execute($self,@p);
    UR::DBI::after_all_fetches_no_sth($_[0],$time,$self,@p);
    return $ar;
}
sub selectall_hashref
{
    my $self = shift;
    my @p = ($_[0],@_[3..$#_]);    
    UR::DBI::before_execute($self,@p);
    UR::DBI::_disable_dump_explain();
    my $ar = $self->SUPER::selectall_hashref(@_);
    UR::DBI::_restore_dump_explain();
    my $time = UR::DBI::after_execute($self,@p);
    UR::DBI::after_all_fetches_no_sth($_[0],$time,$self,@p);
    return $ar;
}
sub selectrow_arrayref
{
    my $self = shift;
    my @p = ($_[0],@_[2..$#_]);
    UR::DBI::before_execute($self,@p);
    my $ar = $self->SUPER::selectrow_arrayref(@_);        
    my $time = UR::DBI::after_execute($self,@p);
    UR::DBI::after_all_fetches_no_sth($_[0],$time,$self,@p);
    return $ar;
}
sub selectrow_array
{
    my $self = shift;
    my @p = ($_[0],@_[2..$#_]);
    UR::DBI::before_execute($self,@p);
    my @a = $self->SUPER::selectrow_array(@_);    
    my $time = UR::DBI::after_execute($self,@p);
    UR::DBI::after_all_fetches_no_sth($_[0],$time,$self,@p);    
    return @a if wantarray;
    return $a[0];
}
sub DESTROY
{
    UR::DBI::before_execute("destroying connection");
    shift->SUPER::DESTROY(@_);
    UR::DBI::after_execute("destroying connection");
}
#########
#
# Statement handle subclass
#
#########
package UR::DBI::st;
use strict;
use warnings;
use Time::HiRes;
use Sys::Hostname;
our @ISA = qw(DBI::st);
our $global_destruction = 0;
END {
    $global_destruction = 1;
}
sub _mk_mutator {
    my ($class, $method) = @_;
    # Make a more specific key based on the package
    # to try not to conflict with anything else.
    # This must start with 'private_'.  See DBI docs on subclassing.
    my $hash_key = join('_', 'private', lc $class, lc $method);
    $hash_key =~ s/::/_/g;
    my $sub = sub {
        return if $global_destruction;
        my $sth = shift;
        if (@_) {
            $sth->{$hash_key} = shift;
        }
        no warnings;
        return $sth->{$hash_key};
    };
    no strict;
    *{$class . '::' . $method} = $sub;
}
for my $method (qw(execute_time fetch_timing_arrayref last_params_arrayref)) {
    __PACKAGE__->_mk_mutator($method);
}
sub last_params
{
    my $ret = shift->last_params_arrayref;
    unless (defined $ret) {
        $ret = [];
    }
    @{ $ret };
}
sub execute
{
    my $sth = shift;
     
    # (re)-initialize the timing array
    if (my $a = $sth->fetch_timing_arrayref()) {
        # re-executing on a previously used $sth.
        UR::DBI::after_all_fetches_with_sth($sth);
    } 
    else {
        # initialize the $sth on first execute.
        $sth->fetch_timing_arrayref([]);
    }
     
    $sth->last_params_arrayref([@_]);
     
    UR::DBI::before_execute($sth->{Database},$sth->{Statement},@_);
    my $rv = $sth->SUPER::execute(@_);
    UR::DBI::after_execute($sth->{Database},$sth->{Statement},@_);
     
    # record the elapsed time for execution.
    $sth->execute_time($UR::DBI::elapsed_time);
     
    if ($rv)
    {
        if (my $prev = $UR::DBI::prepared_commit{$sth})
        {
            UR::DBI->commit_all_app_db_objects($sth);
        }
        if (my $prev = $UR::DBI::prepared_rollback{$sth})
        {
            UR::DBI->rollback_all_app_db_objects($sth);
        }
    }    
    return $rv;
}
sub fetchrow_array
{
    my $sth = shift;
    UR::DBI::before_fetch($sth,@_);
    UR::DBI::_disable_dump_explain();
    my @a = $sth->SUPER::fetchrow_array(@_);    
    UR::DBI::_restore_dump_explain();
    UR::DBI::after_fetch($sth,@_);
    return @a if wantarray;
    return $a[0];
}
sub fetchrow_arrayref
{
    my $sth = shift;
    UR::DBI::before_fetch($sth,@_);
    UR::DBI::_disable_dump_explain();
    my $ar = $sth->SUPER::fetchrow_arrayref(@_);        
    UR::DBI::_restore_dump_explain();
    UR::DBI::after_fetch($sth,@_);
    return $ar;
}
sub fetchall_arrayref
{
    my $sth = shift;
    UR::DBI::before_fetch($sth,@_);
    UR::DBI::_disable_dump_explain();
    my $ar = $sth->SUPER::fetchall_arrayref(@_);    
    UR::DBI::_restore_dump_explain();
    UR::DBI::after_fetch($sth,@_);
    UR::DBI::after_all_fetches_with_sth($sth,@_);
    return $ar;
}
sub fetchall_hashref
{
    my $sth = shift;
    my @p = @_[1,$#_];
    UR::DBI::before_fetch($sth,@p);
    UR::DBI::_disable_dump_explain();
    my $ar = $sth->SUPER::fetchall_hashref(@_);        
    UR::DBI::_restore_dump_explain();
    UR::DBI::after_fetch($sth,@p);
    UR::DBI::after_all_fetches_with_sth($sth,@_[1,$#_]);
    return $ar;
}
sub fetchrow_hashref
{
    my $sth = shift;
    UR::DBI::before_fetch($sth,@_);
    UR::DBI::_disable_dump_explain();
    my $ar = $sth->SUPER::fetchrow_hashref(@_);        
    UR::DBI::_restore_dump_explain();
    UR::DBI::after_fetch($sth,@_);
    return $ar;
}
sub fetch {
    my $sth = shift;
    UR::DBI::before_fetch($sth,@_);
    my $rv = $sth->SUPER::fetch(@_);
    UR::DBI::after_fetch($sth,@_);
    return $rv;
}
sub finish {
    my $sth = shift;    
    UR::DBI::after_all_fetches_with_sth($sth);    
    return $sth->SUPER::finish(@_);
}
sub DESTROY
{
    delete $UR::DBI::prepared_commit{$_[0]};
    delete $UR::DBI::prepared_rollback{$_[0]};
    #print $sql_fh "DESTROY1\n";
    UR::DBI::after_all_fetches_with_sth(@_); # does nothing if called previously by finish()
    #print $sql_fh "DESTROY2\n";
    #Carp::cluck();
    shift->SUPER::DESTROY(@_);
}
$UR::DBI::STATEMENT_ID = $$ . '@' . hostname();
$UR::DBI::EXPLAIN_PLAN_DML = "explain plan set statement_id = '$UR::DBI::STATEMENT_ID' into plan_table for ";
$UR::DBI::EXPLAIN_PLAN_SQL = qq/
select
    LPAD(' ',p.LVL-1) || OPERATION OPERATION,
    OPTIONS,
    --(case when p.OBJECT_OWNER is null then '' else p.OBJECT_OWNER || '.' end)
    --    ||
        p.OBJECT_NAME
        ||
        (case when p.OBJECT_TYPE is null then '' else ' (' || p.OBJECT_TYPE || ')' end)
        "OBJECT",
    (case
        when i.table_name is not null then i.table_name
            || '('
            || index_column_names
            || ')'
        else ''
    end) "OBJECT_IS_ON",
    p.COST,
    p.CARDINALITY CARD,
    p.BYTES,
    p.OPTIMIZER,
    p.CPU_COST CPU,
    p.IO_COST IO,
    p.TEMP_SPACE TEMP,
    i.index_type "index_type",
    i.last_analyzed "index_analyzed"
from
(
    SELECT plan_table.*, level lvl
    FROM PLAN_TABLE
    CONNECT BY prior id = parent_id AND prior statement_id = statement_id
    START WITH id = 0
    AND statement_id = '$UR::DBI::STATEMENT_ID'
) p
full join dual on dummy = dummy
left join all_indexes i
    on i.index_name = p.object_name
    and i.owner = p.object_owner
left join
    (
        select
            index_owner,
            index_name,
            LTRIM(MAX(SYS_CONNECT_BY_PATH(ic.column_name,',')) KEEP (DENSE_RANK LAST ORDER BY ic.column_position),',') index_column_names
        from (
            select ic.index_owner, ic.index_name, ic.column_name, ic.column_position
            from all_ind_columns ic
        ) ic
        group by ic.index_owner, ic.index_name
        connect by
                index_owner = prior index_owner
                and index_name = prior index_name
                and column_position = PRIOR column_position + 1
        start with column_position = 1
    ) index_columns_stringified
    on index_columns_stringified.index_owner = i.owner
    and index_columns_stringified.index_name = i.index_name
where p.object_name is not null
ORDER BY p.id
/;
$UR::DBI::EXPLAIN_PLAN_CLEANUP_DML = "delete from plan_table where statement_id = '$UR::DBI::STATEMENT_ID'";
1;
__END__
HideShow 10 lines of Pod
=pod
=back
=head1 SEE ALSO
UR(3), UR::DataSource::RDBMS(3), UR::Context(3), UR::Object(3)
=cut
#$Header$