DBD-Oracle

 view release on metacpan or  search on metacpan

examples/ora_explain.pl  view on Meta::CPAN

#   $GrabDetails     ROText used to display the selected statement details
use vars qw($ProgName $Db $DbName $User $Schema $SqlMarker $OracleVersion
            $CharWidth $Plan $LoginDialog $SchemaDialog $OpenDialog $SaveDialog
            $FileDir $PlanMain $PlanTitle $PlanTree $PlanStep $PlanSql $Balloon
            $GrabMain $GrabStatus $GrabSelection $GrabSql $GrabDetails);
$SqlMarker = "/* This statement was generated by explain */";

################################################################################
# Switch the hourglass on or off

sub busy($)
{
my ($state) = @_;
if ($state && $PlanMain->grabCurrent()) { $PlanMain->Busy(-recurse => 1); }
else { $PlanMain->Unbusy(1); }
}

################################################################################
# Display an error message in a dialog

sub error($@)
{
my ($parent, @lines) = @_;

my ($msg, $height, $width);

examples/ora_explain.pl  view on Meta::CPAN

$msg =~ s/(indicator at char \d+ in) /$1\n/;
@lines = split("\n", $msg);
$height = @lines;
$width = 0;
foreach my $line (@lines)
   { my $l = length($line); $width = $l if ($l > $width); }
$width = 80 if ($width > 80);
$height = 4 if ($height < 4);
$height = 10 if ($height > 10);

busy(0);
my $dialog = $PlanMain->Toplevel(-title => "Error");
$dialog->withdraw();
my $text = $dialog->Scrolled("ROText", -height => $height, -width => $width,
                             -borderwidth => 3, -relief => "raised",
                             -wrap => "word", -scrollbars => "oe")
   ->pack(-padx => 6, -pady => 6, -expand => 1, -fill => "both");
$text->insert("1.0", $msg);

my $ok_cb = sub { $dialog->destroy() };
$dialog->Button(-text => "OK", -default => "active", -command => $ok_cb)

examples/ora_explain.pl  view on Meta::CPAN

}

################################################################################
# Login to the database.  The new database handle is put into $Db, and the
# Oracle version number is put into $OracleVersion

sub login($$$)
{
my ($database, $username, $password) = @_;

busy(1);
# Close any existing handle
if ($Db)
   {
   $Db->disconnect();
   $Db = undef;
   $DbName = $User = $Schema = undef;
   update_title();
   }

# Connect and initialise

examples/ora_explain.pl  view on Meta::CPAN

$qry->execute();
if (! $qry->fetchrow_arrayref())
   {
   $qry->finish();
   $Db->disconnect();
   $Db = undef;
   die("User $User does not have a PLAN_TABLE.\n",
       "Run the script utlxplan.sql to create one.\n");
   }

busy(0);
return(1);
}

################################################################################
# Clear the plan tree & details windows

sub clear_plan()
{
$PlanTitle->configure(-text => "Query Plan") if ($PlanTitle);
$PlanTree->delete("all") if ($PlanTree);

examples/ora_explain.pl  view on Meta::CPAN

}

################################################################################
# Display the structure of an index

sub disp_index($$)
{
my ($owner, $index) = @_;

# Create the index definition frame
busy(1);
my $dialog = $PlanMain->Toplevel(-title => "Index");
$dialog->withdraw();
$dialog->resizable(0, 0);
my $index_fr = $dialog->Frame(-borderwidth => 3, -relief => "raised");
$index_fr->Label(-text => "$owner.$index", -relief => "ridge",
                 -borderwidth => 1)
   ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we",
          -ipadx => 3);
$index_fr->Label(-text => "Table", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3);

examples/ora_explain.pl  view on Meta::CPAN

$index_fr->Label(-text => $col_txt, -relief => "ridge", -borderwidth => 1,
                 -justify => "left")
   ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3);
$index_fr->pack(-side => "top", -fill => "x");

# Pack the grid and add the close button
$dialog->Button(-text => "Close", -command => sub { $dialog->destroy(); })
   ->pack(-padx => 6, -pady => 6);

$dialog->Popup();
busy(0);
return(1);
}

################################################################################
# Callback for adding/removing index definitions to a table dialog

sub disp_table_cb($$$$$)
{
my ($owner, $table, $num_cols, $index_fr, $index_bn) = @_;

# If this is the first time through, fetch the index definitions
busy(1);
if (! $index_fr->children())
   {
   # This will retrieve the names & owners of all the indexes on the table
   my $qry = $Db->prepare(qq(
      $SqlMarker select owner, index_name
      from all_indexes
      where table_owner = :1 and table_name = :2
   order by owner, index_name
   ));

examples/ora_explain.pl  view on Meta::CPAN

if ($index_bn->cget(-text) eq "Indexes")
   {
   $index_bn->configure(-text => "Hide Indexes");
   $index_fr->pack(-side => "right", -expand => 1);
   }
else
   {
   $index_bn->configure(-text => "Indexes");
   $index_fr->packForget();
   }
busy(0);
return(1);
}

################################################################################
# Display a popup dialog showing the structure of a table

sub disp_table($$)
{
my ($owner, $table) = @_;

# Create the dialog for displaying the object details
busy(1);
my $dialog = $PlanMain->Toplevel(-title => "Table");
$dialog->withdraw();
$dialog->resizable(0, 0);

# Create the table definition frame
my $box1 = $dialog->Frame(-borderwidth => 3, -relief => "raised");
my $box2 = $box1->Frame(-borderwidth => 0);
my $table_fr = $box2->Frame(-borderwidth => 1, -relief => "flat");
$table_fr->Label(-text => "$owner.$table",
            -relief => "ridge", -borderwidth => 1)

examples/ora_explain.pl  view on Meta::CPAN

$box1->Button(-text => "Close", -command => sub { $dialog->destroy(); })
   ->pack(-padx => 6, -side => "left", -expand => 1);
my $index_bn;
$index_bn = $box1->Button(-text => "Indexes")
   ->pack(-padx => 6, -side => "left", -expand => 1);
$index_bn->configure(-command => sub { disp_table_cb($owner, $table, $num_cols,
                                                     $index_fr, $index_bn); });
$box1->pack(-side => "bottom", -pady => 6);

$dialog->Popup();
busy(0);
return(1);
}

################################################################################
# Display the query plan tree

sub disp_plan_tree()
{
$PlanTitle->configure(-text => $Plan->{title});
$PlanTree->delete("all");

examples/ora_explain.pl  view on Meta::CPAN


sub disp_plan_step_obj($)
{
my ($key) = @_;

# Get the plan step & return if it doesn't refer to an object
my $row = $Plan->{key}{$key};
return(1) if (! $row->{OBJECT_NAME});

# Work out the type of the object - table or index
busy(1);
my $qry = $Db->prepare(qq(
   $SqlMarker select object_type from all_objects
   where object_name = :1 and owner = :2
));
$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
   || die("Object type:\n$DBI::errstr\n");
my ($object_type) = $qry->fetchrow_array();
$qry->finish();
busy(0);

if ($object_type eq "TABLE")
   {
   disp_table($row->{OBJECT_OWNER}, $row->{OBJECT_NAME});
   }
elsif ($object_type eq "INDEX")
   {
   disp_index($row->{OBJECT_OWNER}, $row->{OBJECT_NAME});
   }
else

examples/ora_explain.pl  view on Meta::CPAN


sub disp_index_popup($)
{
my ($key) = @_;

# Get the plan step & return if it doesn't refer to an object
my $row = $Plan->{key}{$key};
return(1) if (! $row->{OBJECT_NAME});

# Work out the type of the object - table or index
busy(1);
my $qry = $Db->prepare(qq(
   $SqlMarker select object_type from all_objects
   where object_name = :1 and owner = :2
));
$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
   || die("Object type:\n$DBI::errstr\n");
my ($object_type) = $qry->fetchrow_array();
$qry->finish();
if ($object_type ne "TABLE")
   {
   busy(0);
   return(1);
   }

# Build the popup menu
$qry = $Db->prepare(qq(
   $SqlMarker select owner, index_name from all_indexes
   where table_name = :1 and table_owner = :2
));
$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
   || die("Table indexes:\n$DBI::errstr\n");

examples/ora_explain.pl  view on Meta::CPAN

               
$menu->separator();
my $count = 0;
while ((my ($index_owner, $index_name) = $qry->fetchrow_array()))
   {
   $menu->command(-label => "$index_owner.$index_name",
                  -command => [ \&disp_index, $index_owner, $index_name ]);
   $count++;
   }
$qry->finish();
busy(0);
$menu->Popup(-popover => "cursor", -popanchor => "nw") if ($count);
return(1);
}

################################################################################
# Produce the query plan for the SQL in $PlanSql and store it in $Plan

sub _explain()
{
# Check there is some SQL

examples/ora_explain.pl  view on Meta::CPAN

if ($OracleVersion ge "8")
   { $plan_sql .= qq(, partition_start, partition_stop, partition_id) };
$plan_sql .= qq(
  from plan_table
  where statement_id = :1
  connect by prior id = parent_id and statement_id = :1
  start with id = 0 and statement_id = :1
);

# Clean any old stuff from the plan_table
busy(1);
$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
        undef, $$)
   || die("Delete from plan_table:\n$DBI::errstr\n");
$Db->commit();

# Switch schema if required
if ($Schema ne $User)
   {
   $Db->do(qq($SqlMarker alter session set current_schema = $Schema))
      || die("Cannot change schema to $Schema:\n$DBI::errstr\n");

examples/ora_explain.pl  view on Meta::CPAN

      }
   }
# Top of the tree is step 0
$Plan->{tree} = $Plan->{id}[0];

# Clean up
$qry->finish();
$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
   undef, $$);
$Db->commit();
busy(0);
return(1);
}

################################################################################
# Wrapper for _explain - adds error handling

sub explain
{
clear_plan();
if (! eval { _explain(); }) { error($PlanMain, $@); }

examples/ora_explain.pl  view on Meta::CPAN


################################################################################
# Display info from v$sqlarea for the selected statement in the SQL cache

sub disp_sql_cache_info($$)
{
my ($address, $puid) = @_;

# Empty the widget & prepare the SQL
$GrabDetails->delete("1.0", "end");
busy(1);
my $qry = $Db->prepare(qq(
   $SqlMarker select executions, disk_reads, buffer_gets, rows_processed,
                     sorts, loads, parse_calls, first_load_time
   from v\$sqlarea where address = :1
)) || die("Statement info:\n$DBI::errstr\n");

# Read the info.  Note that the statement *may* have been purged from the cache!
$qry->execute($address);
if (! (my ($executions, $disk_reads, $buffer_gets, $rows_processed,
           $sorts, $loads, $parse_calls, $first_load_time)

examples/ora_explain.pl  view on Meta::CPAN

        "Disk reads:      %8.1f   Buffer gets:    %8.1f   "
      . "Rows processed: %8.1f\n"
      . "Sorts:           %8.1f   Loads:          %8.1f   "
      . "Parse calls:    %8.1f\n";
      $GrabDetails->insert("end",
         sprintf($fmt, $disk_reads / $executions, $buffer_gets / $executions,
                 $rows_processed / $executions, $sorts / $executions,
                 $loads / $executions, $parse_calls / $executions));
      }
   }
busy(0);

# Display the formatted info
return(1);
}

################################################################################
# Callback for whenever a bit of grabbed SQL is selected

sub grab_select_cb($$)
{

examples/ora_explain.pl  view on Meta::CPAN

   my ($text, $tag) = @_;
   $text->tag("configure", $tag, -relief => "raised", -borderwidth => 1);
   };
my $normal = sub
   {
   my ($text, $tag) = @_;
   $text->tag("configure", $tag, -relief => "flat");
   };

# Prepare the queries
busy(1);
my $qry1 = qq{$SqlMarker select address, username from v\$sqlarea, all_users};
$qry1 .= qq{ where sql_text not like '\%$SqlMarker\%'};
$qry1 .= qq{ and sql_text not like '\%insert into \%plan_table\%'};
$qry1 .= qq{ and sql_text not like '\%explain plan\%'};
$qry1 .= qq{ and user_id = parsing_user_id}; # if($user || $no_sys);
$qry1 .= qq{ and username = :1} if ($user);
$qry1 .= qq{ and username not in ('SYS', 'SYSTEM')} if ($no_sys);
if ($ordering eq "total")
   { $qry1 .= qq{ order by $order_by $sort_by}; }
elsif ($ordering eq "average")

examples/ora_explain.pl  view on Meta::CPAN

   if ($rows > 0)
      { $GrabStatus->configure(-text => "$count of $rows queries grabbed"); }
   else
      { $GrabStatus->configure(-text => "$count queries grabbed"); }
   }

# Clean up
$qry1->finish();
grab_select_cb($GrabSql, $first_address) if ($first_address);
$GrabStatus->configure(-text => "$count queries grabbed");
busy(0);
return(1);
}

################################################################################
# Create a top-level window for getting SQL from the shared pool cache

sub grab_main
{
# If it already exists, just make it visible)
if ($GrabMain)



( run in 0.358 second using v1.01-cache-2.11-cpan-87723dcf8b7 )