—

              
#!/usr/bin/env perl 
################################################################################
# Copyright (c) 1999 Alan Burlison
#
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License, as specified in the Perl README file.
#
# This code is provided with no warranty of any kind, and is used entirely at
# your own risk.
#
# This code was written by the author as a private individual, and is in no way
# endorsed or warrantied by Sun Microsystems.
#
# Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com
#
################################################################################
use strict;
use warnings;
use File::Basename;
use DBI;
use Tk;
use Tk::Balloon;
use Tk::ErrorDialog;
use Tk::ROText;
################################################################################
# Subclassed version of Tk::Tree that allows button3 to have a callback attached
package Tk::B3Tree;
use strict;
use base qw(Tk::Tree);
Construct Tk::Widget qw(B3Tree);
sub ClassInit
{
my ($class, $mw) = @_;
$class->SUPER::ClassInit($mw);
$mw->bind($class, "<3>", "Button3");
return $class;
}
sub Populate
{
my ($self, $args) = @_;
$self->SUPER::Populate($args);
$self->ConfigSpecs(-b3command => [ "CALLBACK", "b3command", "B3command",
                                    undef ]);
}
sub Button3
{
my $w = shift;
my $Ev = $w->XEvent;
my $ent = $w->GetNearest($Ev->y);
return unless (defined($ent) and length($ent));
$w->Callback(-b3command => $ent);
}
################################################################################
package main;
use vars qw($VERSION);
$VERSION = "1.1";
# Globals
#   $ProgName        Program name (without pathname)
#   $Db              Database handle
#   $DbName          Oracle database name
#   $User            Oracle user name
#   $Schema          Oracle schema name
#   $SqlMarker       String used to identify SQL generated by explain
#   $OracleVersion   Oracle version number
#   $CharWidth       Width of a character in pixels
#   $Plan            Current query plan as a Perl data structure
#   $LoginDialog     Login dialog
#   $SchemaDialog    Schema dialog
#   $SaveDialog      Save File dialog
#   $OpenDialog      Open File dialog
#   $FileDir         Current file save/open directory
#   $PlanMain        Query plan main window
#   $PlanTitle       Title of query plan main window
#   $PlanTree        Tree used to display the query plan
#   $PlanStep        ROText used to display the selected plan step details
#   $PlanSql         Text used to allow SQL editing
#   $Balloon         For balloon help
#   $GrabMain        SQL cache grab main window
#   $GrabStatus      Text label used for feedback/status info
#   $GrabSelection   Tag of currently selected SQL statement in the SQL cache
#   $GrabSql         ROText used to hold the contents of the SQL cache
#   $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);
$msg = join("\n", @lines);
$msg =~ s/\n$//;
$msg =~ s/ \(DBD:/\n(DBD:/;
$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)
   ->pack(-padx => 6, -pady => 6);
$dialog->bind("<KeyPress-Return>", $ok_cb);
$dialog->Popup;
}
################################################################################
sub about($;$)
{
my ($parent, $win) = @_;
my $msg = <<EOM;
                               $ProgName version $VERSION
                        Copyright (c) 1998 Alan Burlison
                            Alan.Burlison\@uk.sun.com
 You may distribute under the terms of either the GNU General Public License
 or the Artistic License, as specified in the Perl README file.
 This code is provided with no warranty of any kind, and is used entirely at
 your own risk.
 This code was written by the author as a private individual, and is in no way
 endorsed or warrantied by Sun Microsystems.
EOM
my $dialog;
$dialog = $parent->Toplevel(-title => "About $ProgName");
$dialog->withdraw();
$dialog->resizable(0, 0);
my $text = $dialog->Text(-borderwidth => 3, -width => 80, -height => 16,
                         -relief => "raised")
   ->pack(-padx => 6, -pady => 6);
$text->insert("1.0", $msg);
my $cb;
if ($win)
   {
   $$win = $dialog;
   $cb = sub { $dialog->destroy(); undef($$win); };
   }
else
   {
   $cb = sub { $dialog->destroy(); };
   }
$dialog->Button(-text => "OK", -command => $cb)->pack(-padx => 6, -pady => 6);
$dialog->Popup();
return($dialog);
}
################################################################################
sub update_title()
{
$PlanMain->configure(-title =>
   $User
      ? $User eq $Schema
         ? "$ProgName - connected to $DbName as $User"
         : "$ProgName - connected to $DbName as $User [schema $Schema]"
      : "$ProgName - not connected"
   );
}
################################################################################
sub help($)
{
my ($parent) = @_;
require Tk::Pod;
$parent->Pod(-file => $0, -scrollbars => "e");
}
################################################################################
# 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
$Db = DBI->connect("dbi:Oracle:$database", $username, $password,
                          { AutoCommit => 0, PrintError => 0})
   || die("Can't login to Oracle:\n$DBI::errstr\n");
$Db->{LongReadLen} = 4096;
$Db->{LongTruncOk} = 1;
# Get the user name and check the Oracle version
my $qry = $Db->prepare(qq(
   $SqlMarker select user, version from product_component_version
   where lower(product) like '%oracle%'
));
if (! $qry->execute())
   {
   my $err = $DBI::errstr;
   $qry->finish();
   $Db->disconnect();
   $Db = undef;
   die("Can't fetch Oracle version:\n$err\n");
   }
($User, $OracleVersion) = $qry->fetchrow_array();
$qry->finish();
$DbName = $database || $ENV{TWO_TASK} || $ENV{ORACLE_SID};
$Schema = $User;
# Check there is a plan_table for this user
$qry = $Db->prepare(qq(
   $SqlMarker select 1 from user_tables where table_name = 'PLAN_TABLE'
));
$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);
$PlanStep->delete("1.0", "end") if ($PlanStep);
}
################################################################################
# Clear the SQL editor pane
sub clear_editor()
{
$PlanTitle->configure(-text => "Query Plan") if ($PlanTitle);
$PlanTree->delete("all") if ($PlanTree);
$PlanStep->delete("1.0", "end") if ($PlanStep);
$PlanSql->delete("1.0", "end");
}
################################################################################
# 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);
$index_fr->Label(-text => "Column", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3);
# Show the table columns the index is built upon
my $qry = $Db->prepare(qq(
   $SqlMarker select table_owner, table_name, column_name
   from all_ind_columns
   where index_owner = :1 and index_name = :2
   order by column_position
));
$qry->execute($owner, $index) || die("Index columns:\n$DBI::errstr\n");
# For each column in the index, display its details
my ($tab_txt, $col_txt);
while ((my ($tab_owner, $table, $column) = $qry->fetchrow_array()))
   {
   $tab_txt .= "$tab_owner.$table\n";
   $col_txt .= "$column\n";
   }
$qry->finish();
chop($tab_txt, $col_txt);
$index_fr->Label(-text => $tab_txt, -relief => "ridge", -borderwidth => 1,
                 -justify => "left")
   ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3);
$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
   ));
   # Build up a list of all the indexes
   $qry->execute($owner, $table) || die("Table indexes:\n$DBI::errstr\n");
   my (@indexes, $ind_owner, $ind_name);
   while (($ind_owner, $ind_name) = $qry->fetchrow_array())
      { push(@indexes, { owner => $ind_owner, name => $ind_name }); }
   $qry->finish();
   # Special for no indexes
   if (@indexes == 0)
      {
      $index_fr->Label(-text => "No\nindexes\ndefined", -relief => "ridge",
                       -borderwidth => 1)->pack(-ipadx => 3, -ipady => 4);
      }
   else
      {
      # Do the header label
      $index_fr->Label(-text => "Index\norder", -relief => "ridge",
                       -borderwidth => 1)
         ->grid(-column => 0, -row => 0, -sticky => "we", -ipadx => 3,
                -ipady => 2, -columnspan => scalar(@indexes), -rowspan => 2);
      # This will retrieve (table column id, index position) for an index
      $qry = $Db->prepare(qq(
         $SqlMarker select atc.column_id, aic.column_position
         from all_tab_columns atc, all_ind_columns aic
         where aic.index_owner = :1 and aic.index_name = :2
         and atc.owner = aic.table_owner and atc.table_name = aic.table_name
         and atc.column_name = aic.column_name
         order by aic.index_name, atc.column_id
      ));
      # For each index, add a label describing the index
      my $cb = sub { disp_index($_[1], $_[2]); };
      my $grid_col = 0;
      foreach my $index (@indexes)
         {
         ($ind_owner, $ind_name) = @{$index}{qw(owner name)};
         $qry->execute($ind_owner, $ind_name)
            || die("Index columns:\n$DBI::errstr\n");
         my $index_txt;
         my $col = 1;
         while (my ($col_id, $col_pos) = $qry->fetchrow_array())
            {
            $index_txt .= "\n" x ($col_id - $col) . "$col_pos\n";
            $col = $col_id + 1;
            }
         $index_txt .= "\n" x ($num_cols - ($col - 1));
         chop($index_txt);
         my $label = $index_fr->Label(-text => $index_txt, -relief => "ridge",
                                      -borderwidth => 1, -justify => "left")
            ->grid(-column => $grid_col, -row => 2, -sticky => "w",
                   -ipadx => 3);
         $label->bind("<1>", [ $cb, $ind_owner, $ind_name ]);
         $Balloon->attach($label, -msg => "$ind_owner.$ind_name",
                          -balloonposition => "mouse");
         $grid_col++;
         }
      }
   }
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)
   ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we");
$table_fr->Label(-text => "Name", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3);
$table_fr->Label(-text => "Type", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3);
# This will get the table description
my $qry = $Db->prepare(qq(
   $SqlMarker select column_name, data_type, data_length,
      data_precision, data_scale
   from all_tab_columns
      where owner = :1 and table_name = :2
      order by column_id
   ));
$qry->execute($owner, $table)
   || die("Table columns:\n$DBI::errstr\n");
my ($num_cols, $name_txt, $type_txt);
while ((my ($name, $type, $length, $precision, $scale)
   = $qry->fetchrow_array()))
   {
   if ($precision)
      {
      $type .= "($precision";
      $type .= ",$scale" if ($scale);
      $type .= ")";
      }
   elsif ($type =~ /CHAR/)
      {
      $type .= "($length)";
      }
   $name_txt .= "$name\n";
   $type_txt .= "$type\n";
   $num_cols++;
   }
$qry->finish();
chop($name_txt, $type_txt);
$table_fr->Label(-text => $name_txt, -relief => "ridge", -borderwidth => 1,
                 -justify => "left")
   ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3);
$table_fr->Label(-text => $type_txt, -relief => "ridge", -borderwidth => 1,
                 -justify => "left")
   ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3);
$table_fr->pack(-side => "left");
# Now create a frame for the index definition & pack the whole lot
my $index_fr = $box2->Frame(-borderwidth => 1, -relief => "flat");
$box2->pack();
$box1->pack(-side => "top", -fill => "x", -expand => 1);
# Create the buttons at the bottom
$box1 = $dialog->Frame(-borderwidth => 0);
$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");
my $steps = 0;
foreach my $step (@{$Plan->{id}})
   {
   my $item = $PlanTree->add($step->{key}, -text => $step->{desc});
   $steps++;
   }
$PlanTree->autosetmode();
if ($steps)
   {
   $PlanTree->selectionSet("1");
   disp_plan_step("1");
   }
}
################################################################################
# Display the statistics for a given plan step
sub disp_plan_step($)
{
my ($key) = @_;
my $row = $Plan->{key}{$key};
$PlanStep->delete("1.0", "end");
my $info = "";
$info .= "Cost:\t\t$row->{COST}\t(Estimate of the cost of this step)\n"
       . "Cardinality:\t$row->{CARDINALITY}\t"
       . "(Estimated number of rows fetched by this step)\n"
       . "Bytes:\t\t$row->{BYTES}\t"
       . "(Estimated number of bytes fetched by this step)\n"
   if ($row->{COST});
$info .= "\nPartition\nStart:\t$row->{PARTITION_START}\tStop:\t\t"
       . "$row->{PARTITION_STOP}\tId:\t\t$row->{PARTITION_ID}\n"
   if ($row->{PARTITION_START});
$info .= "\nSQL used by Parallel Query Slave:\n$row->{OTHER}"
   if ($row->{OTHER});
$PlanStep->insert("1.0", $info);
}
################################################################################
# Display a popup dialog showing the structure of the table or index used in
# the passed plan step
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
   {
   die("Unknown object type $object_type",
       "for $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}\n");
   }
}
################################################################################
# Display a list of available indexes on a table, and display the selected
# table definition
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");
my $menu = $PlanMain->Menu(-tearoff => 0, -disabledforeground => "#000000");
$menu->command(-label => "Indexes", -state => "disabled");
                
$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
my $stmt = $PlanSql->get("1.0", "end");
$stmt =~ s/;//g;
die("You have not supplied any SQL\n") if ($stmt =~ /^\s*$/);
# Check we are logged on
die("You are not logged on to Oracle\n") if (! $Db);
# Set up the various query strings
# Note that for some reason you can't use bind variables in 'explain plan'
my $prefix = "explain plan set statement_id = '$$' for\n";
my $plan_sql = qq(
   $SqlMarker select level, operation, options, object_node, object_owner,
      object_name, object_instance, object_type, id, parent_id, position,
      other);
if ($OracleVersion ge "7.3")
   { $plan_sql .= qq(, cost, cardinality, bytes, other_tag) };
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");
   }
# Explain the plan - need to save message if failed!
$Plan = { schema => $Schema, sql => $stmt };
my $fail;
$fail = $DBI::errstr if (!$Db->do($prefix . $stmt));
# Switch back schema if required
if ($Schema ne $User)
   {
   $Db->do(qq($SqlMarker alter session set current_schema = $User))
      || die("Set current schema to $User:\n$DBI::errstr\n");
   }
# Now we can safely die if the exmplai  plan failed
die("Explain plan:\n$fail\n") if ($fail);
# Read back the plan
my $qry = $Db->prepare($plan_sql)
   || die("Unsupported PLAN_TABLE format:\n$DBI::errstr\n");
$qry->execute($$) || die("Read plan:\n$DBI::errstr\n");
while (my $row = $qry->fetchrow_hashref())
   {
   if ($row->{ID} == 0)
      {
      $Plan->{title} = "Query Plan for " . lc($row->{OPERATION});
      $Plan->{title} .= ".  Cost = $row->{POSITION}" if ($row->{POSITION});
      }
   else
      {
      # Line wrap the OTHER field
      $row->{OTHER} =~ s/((.{1,80})(\s+|,|$))/$1\n/g if ($row->{OTHER});
      # Construct a descriptive string for the query step
      my $desc = "$row->{OPERATION}";
      $desc .= " $row->{OPTIONS}" if ($row->{OPTIONS});
      $desc .= " $row->{OBJECT_TYPE}" if ($row->{OBJECT_TYPE});
      $desc .= " of $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}"
         if ($row->{OBJECT_OWNER} && $row->{OBJECT_NAME});
      $desc .= " using PQS $row->{OBJECT_NODE} $row->{OTHER_TAG}"
         if ($row->{OBJECT_NODE});
      $row->{desc} = $desc;
      # Construct a hierarchical key for the query step
      if (! $row->{PARENT_ID})
         {
         my $key = "$row->{POSITION}";
         $row->{key} = $key;
         $Plan->{id}[$row->{ID} - 1] = $row;
         $Plan->{key}{$key} = $row;
         }
      else
         {
         my $parent = $Plan->{id}[$row->{PARENT_ID} - 1];
         my $key = "$parent->{key}.$row->{POSITION}";
         $row->{key} = $key;
         $Plan->{id}[$row->{ID} - 1] = $row;
         $Plan->{key}{$key} = $row;
         $parent->{child}[$row->{POSITION} - 1] = $row;
         }
      }
   }
# 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, $@); }
else { disp_plan_tree(); }
}
################################################################################
# Display a login dialog
sub login_dialog($)
{
my ($parent) = @_;
# Create the dialog
if (! $LoginDialog)
   {
   my $username = "/";
   my $password = "";
   my $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID};
   $LoginDialog = $parent->Toplevel(-title => "Login to Oracle");
   $LoginDialog->withdraw();
   $LoginDialog->resizable(0, 0);
   my $box;
   # Create the entry labels & fields
   $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised");
   $box->Label(-text => "Username")
      ->grid(-column => 0, -row => 0, -sticky => "w");
   $box->Entry(-textvariable => \$username, -width => 30)
      ->grid(-column => 1, -row => 0, -sticky => "w");
   $box->Label(-text => "Password")
      ->grid(-column => 0, -row => 1, -sticky => "w");
   $box->Entry(-textvariable => \$password, -width => 30, -show => "*")
      ->grid(-column => 1, -row => 1, -sticky => "w");
   $box->Label(-text => "Database")
      ->grid(-column => 0, -row => 2, -sticky => "w");
   $box->Entry(-textvariable => \$database, -width => 30)
      ->grid(-column => 1, -row => 2, -sticky => "w");
   $box->pack(-expand => 1, -fill => "both", -ipadx => 6, -ipady => 6);
   # Create the buttons & callbacks
   $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised");
   my $cb = sub
      {
      if (! eval { login($database, $username, $password); })
         {
         error($parent, $@);
         $LoginDialog->raise($parent);
         }
      else
         {
         update_title();
         $LoginDialog->withdraw();
         }
      };
   $box->Button(-text => "Login", -default => "active", -command => $cb)
      ->pack(-side => "left", -expand => 1, -pady => 6);
   $box->Button(-text => "Cancel", -command => sub { $LoginDialog->withdraw() })
      ->pack(-side => "right", -expand => 1, -pady => 6);
   $box->pack(-expand => 1, -fill => "both");
   $LoginDialog->bind("<KeyPress-Return>", $cb);
   }
    
# Activate the dialog
$LoginDialog->Popup();
}
################################################################################
sub schema_dialog($)
{
my ($parent) = @_;
if (! $Db)
   {
   error($parent, "You are not logged on to Oracle\n");
   return;
   }
# Create the dialog
if (! $SchemaDialog)
   {
   $SchemaDialog = $parent->Toplevel(-title => "Change Schema");
   $SchemaDialog->withdraw();
   $SchemaDialog->resizable(0, 0);
   my ($box, $schema);
   # Create the entry labels & fields
   $box = $SchemaDialog->Frame(-borderwidth => 1, -relief => "raised");
   $box->Label(-text => "Schema")
      ->pack(-side => "left", -anchor => "e", -expand => 1);
   $box->Entry(-textvariable => \$schema, -width => 30)
      ->pack(-side => "right", -anchor => "w", -expand => 1);
   $box->pack(-expand => 1, -fill => "both", -ipadx => 6, -ipady => 6);
   # Create the buttons & callbacks
   $box = $SchemaDialog->Frame(-borderwidth => 1, -relief => "raised");
   my $cb = sub
      {
      # Try changing to the specified schema
      $schema = uc($schema);
      if (! $Db->do(qq($SqlMarker alter session set current_schema = $schema)))
         {
         error($parent, "Cannot change schema to $schema:", $DBI::errstr);
         $SchemaDialog->raise($parent);
         }
      else
         {
         # Change back to the user's schema
         $Db->do(qq($SqlMarker alter session set current_schema = $User))
            || die("Cannot change schema to $User\n$DBI::errstr");
         $Schema = $schema;
         update_title();
         $SchemaDialog->withdraw();
         }
      };
   $box->Button(-text => "Default", -command => sub { $schema = $User; })
      ->pack(-side => "left", -expand => 1, -pady => 6);
   $box->Button(-text => "Apply", -default => "active", -command => $cb)
      ->pack(-side => "left", -expand => 1, -pady => 6);
   $box->Button(-text => "Cancel",
                -command => sub { $SchemaDialog->withdraw() })
      ->pack(-side => "left", -expand => 1, -pady => 6);
   $box->pack(-expand => 1, -fill => "both");
   $SchemaDialog->bind("<KeyPress-Return>", $cb);
   }
    
# Activate the dialog
$SchemaDialog->Popup();
}
################################################################################
# Open a file and read it into the SQL editor frame
sub open_file($)
{
# Open the file
my ($file) = @_;
use IO::File;
my $fh;
if (! ($fh = IO::File->new($file, "r")))
   {
   error($PlanMain, "Cannot open $file:\n", $!);
   return(0);
   }
# Clear the plan, plan details & SQL editor, then load into the SQL editor
clear_editor();
while (my $line = $fh->getline())
   {
   $PlanSql->insert("end", $line);
   }
$fh->close();
return(1);
}
################################################################################
# Display a file open dialog & load into the SQL editor
sub open_dialog($)
{
my ($parent) = @_;
# Put up the dialog
require Cwd; import Cwd;
require Tk::FileSelect;
$FileDir = cwd() if (! $FileDir);
if (! $OpenDialog)
   {
   $OpenDialog = $parent->FileSelect(-title  => "Open File",
                                     -create => 0);
   }
$OpenDialog->configure(-directory => $FileDir);
my $file = $OpenDialog->Show();
return if (! $file);
$FileDir = $OpenDialog->cget(-directory);
open_file($file);
}
################################################################################
# Display a file save dialog & save the contents of the passed Text widget
sub save_dialog($$)
{
my ($parent, $text) = @_;
# Put up the dialog
require Cwd; import Cwd;
require IO::File;
require Tk::FileSelect;
$FileDir = cwd() if (! $FileDir);
if (! $SaveDialog)
   {
   $SaveDialog = $parent->FileSelect(-title  => "Save File",
                                     -create => 1);
   }
$SaveDialog->configure(-directory => $FileDir);
my $file = $SaveDialog->Show();
return if (! $file);
$FileDir = $SaveDialog->cget(-directory);
# Save the Text widget contents to the selected file
my $fh;
if (! ($fh = IO::File->new($file, "w")))
   {
   error($PlanMain, "Cannot open $file:\n", $!);
   return;
   }
$fh->print($text->get("1.0", "end"));
$fh->close();
}
################################################################################
# Copy SQL from the grab window into the explain SQL editor
sub copy_sql($$)
{
my ($text, $tag) = @_;
return if (! defined($tag));
clear_editor();
$PlanSql->insert("end", $text->get("$tag.first", "$tag.last"));
$Schema = $text->tag("cget", $tag, -data);
update_title();
$PlanMain->deiconify();
}
################################################################################
# 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)
   = $qry->fetchrow_array()))
   {
   $GrabDetails->insert("1.0", "This statement is no longer in the SQL cache");
   }
else
   {
   $first_load_time =~ s!/! !;
   $GrabDetails->insert("1.0", "First executed by user", "bold",
                        "      $puid   ", "",
                        "        at", "bold", "   $first_load_time\n");
   $GrabDetails->insert("end", "Total                       ", "bold");
   $GrabDetails->insert("end", sprintf("Executions:     %8d\n", $executions));
   my $fmt =
     "Disk reads:      %8d   Buffer gets:    %8d   Rows processed: %8d\n"
   . "Sorts:           %8d   Loads:          %8d   Parse calls:    %8d\n";
   $GrabDetails->insert("end",
      sprintf($fmt, $disk_reads, $buffer_gets, $rows_processed,
              $sorts, $loads, $parse_calls));
   if ($executions > 0)
      {
      $GrabDetails->insert("end", "Average per Execution\n", "bold");
      $fmt =
        "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($$)
{
my ($text, $tag) = @_;
$text->tag("configure", $GrabSelection, -background => undef)
   if ($GrabSelection);
$text->tag("configure", $tag, -background => "#43ce80");
my $puid = $text->tag("cget", $tag, -data);
$GrabSelection = $tag;
if (! eval { disp_sql_cache_info($tag, $puid); })
   { error($GrabMain, $@); }
}
################################################################################
# Scan v$sqlarea for SQL statements matching the specified conditions.
#    $order_by is a v$sqlarea column name used to rank the statements
#    $sort_by is "asc" or "desc"
#    $user is who first issued the statement (case insensitive)
#    $pattern is a perl regexp used to filter the SQL
#    $rows is the maximum number of rows to display
sub grab($$$$$$$)
{
my ($ordering, $order_by, $sort_by, $no_sys, $user, $pattern, $rows) = @_;
# Check we are logged on
die("You are not logged on to Oracle\n") if (! $Db);
# Munge args as necessary
$no_sys = $no_sys ? qq{and user_name not in ('SYS', 'SYSTEM')} : qq{};
$rows   = -1 if ($rows !~ /^\d+$/);
$user   = uc($user);
# Clear the frames
$GrabSql->delete("1.0", "end");
$GrabDetails->delete("1.0", "end");
$GrabStatus->configure(-text => "Please wait...");
# Define the callbacks for highlighting etc
my $highlight = sub
   {
   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")
   { $qry1 .= qq{ order by $order_by / greatest(executions, 1) $sort_by}; }
$qry1 = $Db->prepare($qry1) || die("SQL Cache capture:\n$DBI::errstr\n");
my $qry2;
if ($OracleVersion ge "7.2")
   {
   $qry2 = $Db->prepare(qq(
      $SqlMarker select sql_text from v\$sqltext_with_newlines
      where address = :1 order by piece))
      || die("SQL text:\n$DBI::errstr\n");
   }
else{
   $qry2 = $Db->prepare(qq(
      $SqlMarker select sql_text from v\$sqltext
      where address = :1 order by piece))
      || die("SQL text:\n$DBI::errstr\n");
   }
# For each SQL query in the shared pool...
if ($user) { $qry1->execute($user) || die("SQL text:\n$DBI::errstr\n"); }
else { $qry1->execute() || die("SQL text:\n$DBI::errstr\n"); }
my $count = 0;
my $first_address;
while ($count != $rows && (my ($address, $puid) = $qry1->fetchrow_array()))
   {
   # ...glue together the components of the SQL string & print out
   $qry2->execute($address) || die("SQL text:\n$DBI::errstr\n");
   my ($sql_text) = "";
   while (my ($sql) = $qry2->fetchrow_array())
      {
      $sql_text .= $sql;
      }
   $qry2->finish();
   $sql_text =~ s/^\s+//;
   $sql_text =~ s/\n\s*\n/\n/;
   $sql_text =~ s/\s+$//s;
   # Skip if it doesn't match the supplied pattern
   next if ($pattern && eval { $sql_text !~ /$pattern/is; });
   # Display the statement and set up the bindings
   $GrabSql->insert("end", $sql_text, $address, "\n\n");
   $GrabSql->tag("configure", $address, -data => $puid);
   $GrabSql->tag("bind", $address, "<Any-Enter>" => [ $highlight, $address ]);
   $GrabSql->tag("bind", $address, "<Any-Leave>" => [ $normal, $address ]);
   $GrabSql->tag("bind", $address, "<Double-1>" => [ \&copy_sql, $address]);
   $GrabSql->tag("bind", $address, "<1>" => [ \&grab_select_cb, $address ]);
   $GrabSql->update();
   $count++;
   $first_address = $address if (! defined($first_address));
   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)
   {
   $GrabMain->deiconify();
   $GrabMain->raise($PlanMain);
   return;
   }
# Otherwise, build the grab window
$GrabMain = $PlanMain->Toplevel(-title => "$ProgName - SQL cache");
$GrabMain->protocol("WM_DELETE_WINDOW", sub { $GrabMain->withdraw(); });
# Defaults & callbacks
my $ordering = "";
my $order_by = "";
my $sort_by  = "";
my $no_sys   = 1;
my $user     = "";
my $pattern  = "";
my $rows     = 100;
my $grab_cb = sub
   {
   if (! eval { grab($ordering, $order_by, $sort_by, $no_sys,
                     $user, $pattern, $rows); })
      { error($GrabMain, $@); }
   };
my (%ord_bn, %sort_bn);   # For "order by" and "sort order" buttons
my $ord_bn_cb = sub
   {
   if ($ordering eq "")
      {
      $order_by = "";
      $sort_by = "";
      foreach my $bn (values(%ord_bn))
         { $bn->configure(-state => "disabled"); }
      foreach my $bn (values(%sort_bn))
         { $bn->configure(-state => "disabled"); }
      }
   elsif ($ordering eq "total")
      {
      $order_by = "disk_reads" if ($order_by eq "");
      $sort_by = "desc" if ($sort_by eq "");
      foreach my $bn (values(%ord_bn))
         { $bn->configure(-state => "normal"); }
      foreach my $bn (values(%sort_bn))
         { $bn->configure(-state => "normal"); }
      }
   else # $ordering eq "average"
      {
      $order_by = "disk_reads"
         if ($order_by eq "" || $order_by eq "executions");
       $sort_by = "desc" if ($sort_by eq "");
      foreach my $bn (values(%ord_bn))
         { $bn->configure(-state => "normal"); }
      $ord_bn{executions}->configure(-state => "disabled");
      $ord_bn{first_load_time}->configure(-state => "disabled");
      foreach my $bn (values(%sort_bn))
         { $bn->configure(-state => "normal"); }
      }
   };
### Menubar
my $menubar = $GrabMain->Frame(-relief => "raised", -borderwidth => 3);
$menubar->pack(-fill => "x");
my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0);
$menubar_file->command(-label => "Save File ...", -underline => 0,
   -command => sub { save_dialog($PlanMain, $GrabSql); });
$menubar_file->separator();
$menubar_file->command(-label => "Capture SQL", -underline => 0,
   -command => $grab_cb);
$menubar_file->command(-label => "Copy to Explain", -underline => 9,
   -command => sub { copy_sql($GrabSql, $GrabSelection); });
$menubar_file->command(-label => "Close", -underline => 1,
   -command => sub { $GrabMain->withdraw(); });
$menubar_file->pack(-side => "left");
my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0);
$menubar_help->command(-label => "About ...", -underline => 0,
   -command => sub { about($GrabMain); });
$menubar_help->command(-label => "Usage ...", -underline => 0,
   -command => sub { help($GrabMain); });
$menubar_help->pack(-side => "right");
### SQL cache display
my ($frame, $frame1, $frame2, $frame3);
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame1 = $frame->Frame(-highlightthickness => 0);
$frame1->Label(-text => "SQL Cache")->pack(-side => "left");
$GrabStatus = $frame1->Label(-text => "")->pack(-side => "right");
$frame1->pack(-fill => "x");
$GrabSql = $frame->Scrolled("ROText", -setgrid => "true", -scrollbars => "oe",
                            -height => 15, -width => 80, -borderwidth => 0,
                            -wrap => "word")
   ->pack(-fill => "both", -expand => 1);
$frame->pack(-fill => "both", -expand => 1);
### SQL statement details
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "SQL Statement Statistics")->pack(-anchor => "nw");
$GrabDetails = $frame->ROText(-height => 7, -width => 80, -borderwidth => 0,
                              -setgrid => "true", -wrap => "none")
   ->pack(-fill => "x");
$GrabDetails->tagConfigure("bold", -font => "bold");
$frame->pack(-fill => "x");
### SQL selection
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "SQL Selection Criteria")->pack(-anchor => "w");
$frame1 = $frame->Frame(-highlightthickness => 1);
## SQL sort frame
$frame1->Label(-text => "Order SQL by")
   ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2);
$frame2 = $frame1->Frame(-highlightthickness => 0);
# Ordering frame
$frame3 = $frame2->Frame(-highlightthickness => 1);
$frame3->Radiobutton(-text => "No ordering", -highlightthickness => 0,
                     -value => "", -variable => \$ordering,
                     -command => $ord_bn_cb)
   ->pack(-anchor => "w");
$frame3->Radiobutton(-text => "Total", -highlightthickness => 0,
                    -value => "total", -variable => \$ordering,
                    -command => $ord_bn_cb)
   ->pack(-anchor => "w");
$frame3->Radiobutton(-text => "Average per execution",
                     -highlightthickness => 0, -value => "average",
                     -variable => \$ordering, -command => $ord_bn_cb)
   ->pack(-anchor => "w");
$frame3->pack(-side => "left", -padx => 6);
# Order by frame
$frame3 = $frame2->Frame(-highlightthickness => 1);
$ord_bn{disk_reads} =
   $frame3->Radiobutton(-text => "Disk reads", -highlightthickness => 0,
                        -value => "disk_reads", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 0, -sticky => "w");
$ord_bn{buffer_gets} =
   $frame3->Radiobutton(-text => "Buffer gets", -highlightthickness => 0,
                        -value => "buffer_gets", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 1, -row => 0, -sticky => "w");
$ord_bn{rows_processed} =
   $frame3->Radiobutton(-text => "Rows processed", -highlightthickness => 0,
                        -value => "rows_processed", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 1, -sticky => "w");
$ord_bn{sorts} =
   $frame3->Radiobutton(-text => "Sorts", -highlightthickness => 0,
                        -value => "sorts", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 1, -row => 1, -sticky => "w");
$ord_bn{loads} =
   $frame3->Radiobutton(-text => "Loads", -highlightthickness => 0,
                        -value => "loads", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 2, -sticky => "w");
$ord_bn{parse_calls} =
   $frame3->Radiobutton(-text => "Parse calls", -highlightthickness => 0,
                        -value => "parse_calls", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 1, -row => 2, -sticky => "w");
$ord_bn{executions} =
   $frame3->Radiobutton(-text => "Executions", -highlightthickness => 0,
                        -value => "executions", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 3, -sticky => "w");
$ord_bn{first_load_time} =
   $frame3->Radiobutton(-text => "First load", -highlightthickness => 0,
                        -value => "first_load_time", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 1, -row => 3, -sticky => "w");
$frame3->pack(-side => "left", -padx => 6);
# Sort order frame
$frame3 = $frame2->Frame(-highlightthickness => 1);
$sort_bn{desc} =
   $frame3->Radiobutton(-text => "Descending", -highlightthickness => 0,
                        -value => "desc", -variable => \$sort_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 0, -sticky => "w");
$sort_bn{asc} =
   $frame3->Radiobutton(-text => "Ascending", -highlightthickness => 0,
                        -value => "asc", -variable => \$sort_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 1, -sticky => "w");
$frame3->pack(-side => "right", -padx => 6);
$frame2->grid(-column => 0, -row => 1, -sticky => "w", -columnspan => 2);
## Other options frame
$frame2 = $frame1->Frame(-highlightthickness => 0);
$frame2->Checkbutton(-text => "Exclude queries by SYS or SYSTEM",
                     -variable => \$no_sys, -offvalue => 0, -onvalue => 1,
                     -highlightthickness => 0)
   ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2);
$frame2->Label(-text => "First user to execute statement")
   ->grid(-column => 0, -row => 1, -sticky => "w");
$frame2->Entry(-textvariable => \$user, -width => 30)
   ->grid(-column => 1, -row => 1, -sticky => "w");
$frame2->Label(-text => "SQL matches pattern")
   ->grid(-column => 0, -row => 2, -sticky => "w");
$frame2->Entry(-textvariable => \$pattern, -width => 30)
   ->grid(-column => 1, -row => 2, -sticky => "w");
$frame2->Label(-text => "Maximum number of statements")
   ->grid(-column => 0, -row => 3, -sticky => "w");
$frame2->Entry(-textvariable => \$rows, -width => 4)
   ->grid(-column => 1, -row => 3, -sticky => "w");
$frame2->grid(-column => 0, -row => 2, -sticky => "we",
              -columnspan => 2, -padx => 6, -pady => 6);
$frame1->pack(-fill => "x");
&$ord_bn_cb();   # Set the buttons to the initial state
$frame->pack(-fill => "x", -padx => 6, -pady => 6);
### Buttons
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Button(-text => "Capture SQL", -command => $grab_cb)
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->Button(-text => "Copy to Explain",
               -command => sub { copy_sql($GrabSql, $GrabSelection); })
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->Button(-text => "Close", -command => sub { $GrabMain->withdraw(); })
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->pack(-fill => "x");
}
################################################################################
# Main
### Main window
$ProgName = basename($0);
$ProgName =~ s/\..*$//;
$PlanMain = MainWindow->new();
$PlanMain->withdraw();
update_title();
$Balloon = $PlanMain->Balloon();
### Splash screen
my $splash;
if (@ARGV == 0 || $ARGV[0] ne '-q')
   {
   about($PlanMain, \$splash);
   $splash->after(10000,
                  sub { if ($splash) { $splash->destroy(); undef($splash); } });
   $PlanMain->update();
   }
else
   { shift(@ARGV); }
### Menubar
my $menubar = $PlanMain->Frame(-relief => "raised", -borderwidth => 3);
# Create a bold font $ figure out charcter spacing
my $t = $PlanMain->Text();
my $f = $t->cget(-font);
$t->fontCreate("bold", $PlanMain->fontActual($f), -weight => "bold");
$CharWidth = $PlanMain->fontMeasure($f, "X");
undef($f);
$t->destroy();
undef($t);
my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0);
$menubar_file->command(-label => "Login ...", -underline => 0,
   -command => sub { login_dialog($PlanMain); });
$menubar_file->command(-label => "Schema ...", -underline => 2,
   -command => sub { schema_dialog($PlanMain); });
$menubar_file->command(-label => "Explain", -underline => 0,
   -command => \&explain);
$menubar_file->command(-label => "SQL Cache ...", -underline => 4,
   -command => \&grab_main);
$menubar_file->separator();
$menubar_file->command(-label => "Open File ...", -underline => 0,
   -command => sub { open_dialog($PlanMain); });
$menubar_file->command(-label => "Save File ...", -underline => 0,
   -command => sub { save_dialog($PlanMain, $PlanSql); });
$menubar_file->separator();
$menubar_file->command(-label => "Exit", -underline => 1,
   -command => sub { $Db->disconnect() if ($Db); exit(0); });
$menubar_file->pack(-side => "left");
my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0);
$menubar_help->command(-label => "About ...", -underline => 0,
   -command => sub { about($PlanMain); });
$menubar_help->command(-label => "Usage ...", -underline => 0,
   -command => sub { help($PlanMain); });
$menubar_help->pack(-side => "right");
$menubar->pack(-fill => "x");
### Query plan tree
my $frame;
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
$PlanTitle = $frame->Label(-text => "Query Plan")->pack(-anchor => "nw");
my $b1_cb = sub
   { error($PlanMain, $@) if (! eval { disp_plan_step_obj($_[0])}); };
my $b3_cb = sub
   { error($PlanMain, $@) if (! eval { disp_index_popup($_[0])}); };
$PlanTree = $frame->Scrolled("B3Tree", -height => 15, -width => 80,
                             -borderwidth => 0, -highlightthickness => 1,
                             -scrollbars => "osoe",
                             -browsecmd => \&disp_plan_step,
                             -command => $b1_cb, -b3command => $b3_cb)
   ->pack(-expand => 1, -fill => "both");
$frame->pack(-expand => 1, -fill => "both");
### Query plan statement details
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "Query Step Details")->pack(-anchor => "nw");
$PlanStep = $frame->Scrolled("ROText", -height => 8, -width => 80,
                             -borderwidth => 0, -wrap => "none",
                             -setgrid => "true", -scrollbars => "osoe")
   ->pack(-fill => "x");
$frame->pack(-fill => "x");
### SQL text editor
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "SQL Editor")->pack(-anchor => "nw");
$PlanSql = $frame->Scrolled("Text", -setgrid => "true", -scrollbars => "oe",
                            -borderwidth => 0, -height => 15, -width => 80,
                            -wrap => "word")
   ->pack(-expand => 1, -fill => "both");
$frame->pack(-expand => 1, -fill => "both");
### Buttons
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Button(-text => "Explain", -command => \&explain)
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->Button(-text => "Clear", -command => \&clear_editor)
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->Button(-text => "SQL Cache", -command => \&grab_main)
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->pack(-fill => "x");
### user/pass@db command-line argument processing
$PlanMain->update();
$PlanMain->deiconify();
$splash->raise() if (defined($splash));
if (@ARGV >= 1 && $ARGV[0] =~ /\w*\/\w*(@\w+)?/)
   {
   my ($username, $password, $database) = split(/[\/@]/, shift(@ARGV));
   if (! $username) { $username = "/"; $password = ""; }
   if (! $database) { $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID}; }
   error($PlanMain, $@) if (! eval { login($database, $username, $password); });
   update_title();
   }
else
   {
   login_dialog($PlanMain);
   }
### SQL filename argument processing
if (@ARGV >= 1 && -r $ARGV[0])
   {
   my $file = shift(@ARGV);
   if (open_file($file))
      {
      $FileDir = dirname($file);
      explain() if ($Db);
      }
   }
# Doncha just love GUI programming :-)
MainLoop();
################################################################################
__END__
HideShow 196 lines of Pod
=head1 NAME
ora_explain.pl - Visualise Oracle query plans
=head1 SYNOPSIS
 $ ora_explain.pl [ [ user/password@database ] sql script ]
=head1 DESCRIPTION
Explain is a GUI-based tool that enables easier visualisation of Oracle Query
plans.  A query plan is the access path that Oracle will use to satisfy a SQL
query.  The Oracle query optimiser is responsible for deciding on the optimal
path to use.  Needless to say, understanding such plans requires a fairly
sophisticated knowledge of Oracle architecture and internals.
Explain allows a user to interactively edit a SQL statement and view the
resulting query plan with the click of a single button.  The effects of
modifying the SQL or of adding hints can be rapidly established.
Explain allows the user to capture all the SQL currently cached by Oracle.  The
SQL capture can be filtered and sorted by different criterea, e.g. all SQL
matching a pattern, order by number of executions etc.
Explain is written using Perl, DBI/DBD::Oracle and Tk.
=head1 PREREQUISITES
=over 2
=item 1.
Oracle 7 or Oracle 8, with SQL*Net if appropriate
=item 2.
L<Perl 5.004_04|perl> or later
=item 3.
L<DBI> version 1.02 or later
=item 4.
L<DBD::Oracle> 0.54 or later
=item 5.
L<Tk|Tk::overview> 800.011 or later
=item 6.
L<Tk::Pod> 3.15 or later
=back
Items 2 through 6 can be obtained from any CPAN mirror.
=head1 HOW TO USE
Type "ora_explain.pl" at the shell prompt.  A window will appear with
a menu bar and three frames, labelled "Query Plan", "Query Step Details" and
"SQL Editor".  At the bottom of the window are three buttons labelled
"Explain", "Clear" and "SQL Cache".  A login dialog will also appear, into
which you should enter the database username, password and database instance
name (SID).  The parameters you enter are passed to the DBI->connect() method,
so if you have any problems refer to the DBI and DBD::Oracle documentation.
Optionally you may supply up to two command-line arguments.  If the first
argument is of the form username/password@database, explain will use this to
log in to Oracle, otherwise if it is a filename it will be loaded into the SQL
editor.  If two arguments are supplied, the second one will be assumed to be a
filename.
Examples:
   explain scott/tiger@DEMO query.sql
   explain / query.sql
   explain query.sql
=head2 Explain functionality
The menu bar has two pulldown menus, "File" and "Help".  "File" allows you to
login to Oracle, Change the current schema, Capture the contents of the Oracle
SQL cache, Load SQL from files, Save SQL to files and to Exit the program.
"Help" allows you to view release information and read this documentation.
The "SQL Editor" frame allows the editing of a SQL statement.  This should be
just a single statement - multiple statements are not allowed.  Refer to the
documentation for the Tk text widget for a description of the editing keys
available.  Text may be loaded and saved by using the "File" pulldown menu.
Once you have entered a SQL statement, the "Explain" button at the bottom of
the window will generate the query plan for the statement.  A tree
representation of the plan will appear in the "Query Plan" frame.  Individual
"legs" of the plan may be expanded and collapsed by clicking on the "+' and "-"
boxes on the plan tree.  The tree is drawn so that the "innermost" or "first"
query steps are indented most deeply.  The connecting lines show the
"parent-child" relationships between the query steps.  For a comprehensive
explanation of the meaning of query plans you should refer to the relevant
Oracle documentation.  The "Clear" button will empty the editor & query plan
tree panes.
Single-clicking on a plan step in the Query Plan pane will display more
detailed information on that query step in the Query Step Details frame.  This
information includes Oracle's estimates of cost, cardinality and bytes
returned.  The exact information displayed depends on the Oracle version.
Again, for detailed information on the meaning of these fields, refer to the
Oracle documentation.
Double-clicking on a plan step that refers to either a table or an index will
pop up a dialog box showing the definition of the table or index in a format
similar to that of the SQL*Plus 'desc' command.
The dialog that appears has a button labelled 'Index'.  Clicking on this will
expand the table dialog to show all the indexes defined on the table.  Each
column represents an index, and the figures define the order that the table
columns appears in the index.  To find out the name of an index, position the
mouse over the index column.  A single click will display the definition of the
index in a separate dialog.
Right-clicking on a plan step that refers to a table will pop up a menu showing
a list of the indexes available for the table.  Selecting an index will display
its definition in a dialog box.
=head2 Capture SQL Cache functionality
The explain window has an option on the "File" menu labelled "SQL Cache ...",
as well as a button with the same function.  Selecting this will popup a new
top-level window containing a menu bar and three frames, labelled "SQL Cache",
"SQL Statement Statistics" and "SQL Selection Criteria".  At the bottom of the
window are three buttons labelled "Capture SQL", "Explain" and "Close".
The menu bar has two pulldown menus "File" and "Help".  "File" allows you to
Save the contents of the SQL Cache pane to a file, copy the selected SQL
statement to the Explain window and Close the Grab window.
The "SQL Cache" frame shows the statements currently in the Oracle SQL cache.
As you move the cursor over this window, each SQL statement will be highlighted
with an outline box.  Single-clicking on a statement in the SQL Cache pane will
highlight the statement in green and display more detailed information on that
statement in the SQL Statement Statistics frame.
If you want to save the entire contents of the SQL Cache pane, you can do this
from the "File" menu.
The "SQL Selection Criteria" frame allows you to specify which SQL statements
you are interested in, and how you want them sorted.  The pattern used to select
statements is a normal perl regexp.  Once you have defined the selection
criteria, clicking the "Capture SQL" button will read all the matching
statements from the SQL cache and display them in the top frame.
Double-clicking on a statement in the "SQL Cache" pane, selecting "Explain"
from the "File" menu or clicking the "Explain" button will copy the currently
highlighted statement in the "SQL Cache" pane to the SQL editor in the Explain
window, so that the query plan for the statement can be examined.  Note also
that the current schema will be changed to that of the user who first executed
the captured statement.
=head1 SEE ALSO
This tool assumes that you already know how to interpret Oracle query plans.
If need an explanation of the information displayed by this tool, you should
refer to the appropriate Oracle documentation.  Information can be found in the
"Concepts" and "Oracle Tuning" manuals - look for "Query plan" and "Explain
plan".  Two other useful sources of information are:
   Oracle Performance Tuning, 2nd ed.
      Mark Gurry and Peter Corrigan
      O'Reilly & Associates, Inc.
      ISBN 1-56592-237-9
   Advanced Oracle Tuning and Administration
      Eyal Aronoff, Kevin Loney and Noorali Sonawalla
      Oracle Press (Osborne)
      ISBN 0-07-882241-6
=head1 SUPPORT
Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com
=head1 COPYRIGHT AND DISCLAIMER 
Copyright (c) 1999 Alan Burlison
You may distribute under the terms of either the GNU General Public License
or the Artistic License, as specified in the Perl README file.
This code is provided with no warranty of any kind, and is used entirely at
your own risk.
This code was written by the author as a private individual, and is in no way
endorsed or warrantied by Sun Microsystems.
=cut