# -*- perl -*-

use strict;

my $script = <<'SCRIPT';
~startperl~ -w
#!/usr/local/bin/perl -w

################################################################################
# Copyright (c) 1998 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, with the
# exception that it cannot be placed on a CD-ROM or similar media for commercial
# distribution without the prior approval of the author.
#
# 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 IO::File;
use File::Basename;
use Cwd;
use DBI;
use Tk;
use Tk::ErrorDialog;
use Tk::Pod;
use Tk::Dialog;
use Tk::FileSelect;
use Tk::ROText;
use Tk::Tree;

################################################################################
# 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 = "0.7 beta TEST RELEASE 1";

# Globals
#   $Db              Database handle
#   $SqlMarker       String used to identify SQL generated by explain
#   $OracleVersion   Oracle version number
#   $Plan            Current query plan as a Perl data structure
#   $LoginDialog     Login 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
#   $GrabMain        SQL cache grab main window
#   $GrabFeedback    Label used for feedback during grab
#   $GrabSql         ROText used to hold the contents of the SQL cache
#   $GrabDetails     ROText used to display the selected statement details
use vars qw($Db $SqlMarker $OracleVersion $Plan
            $LoginDialog $OpenDialog $SaveDialog $FileDir
            $PlanMain $PlanTitle $PlanTree $PlanStep $PlanSql
            $GrabMain $GrabFeedback $GrabSql $GrabDetails);
$SqlMarker = "/* This statement was generated by explain */";

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

sub busy($$)
{
my ($win, $state) = @_;
if ($state eq "on")
   {
   if ($win eq "plan" || $win eq "all")
      { $PlanMain->Busy(); }
   if (defined($GrabMain) && ($win eq "grab" || $win eq "all"))
      { $GrabMain->Busy(); }
   }
else
   {
   if ($win eq "plan" || $win eq "all")
      { $PlanMain->Unbusy(); }
   if (defined($GrabMain) && ($win eq "grab" || $win eq "all"))
      { $GrabMain->Unbusy(); }
   }
}

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

sub error($@)
{
my ($parent) = shift(@_);
busy("all", "off");
$PlanMain->Dialog(-title      => "Error",
                  -bitmap     => "error",
                  -text       => join("\n", @_),
                  -wraplength => "80c",
                  -buttons    => ["OK"] )->Show();
}

################################################################################

sub about($)
{
my $msg = <<EOM;
                            Explain 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, with the
exception that it cannot be placed on a CD-ROM or similar media for commercial
distribution without the prior approval of the author.

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

$PlanMain->Dialog(-title  => "About Explain",
                  -text       => $msg,
                  -wraplength => "80c",
                  -buttons    => ["OK"] )->Show();
}

################################################################################

sub help($)
{
my ($parent) = @_;
$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("all", "on");
# Close any existing handle
if ($Db)
   {
   $Db->disconnect();
   $Db = undef;
   }

# Connect and initialise
$Db = DBI->connect("dbi:Oracle:$database", $username, $password,
                          { AutoCommit => 0, PrintError => 0})
   || die("Can't login to Oracle: $DBI::errstr\n");
$Db->{LongReadLen} = 4096;
$Db->{LongTruncOk} = 1;

# Check there is a plan_table for this user
my $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 $username does not have a PLAN_TABLE.\n",
       "Run the script utlxplan.sql to create one.\n");
   }

# Check the Oracle version
$qry = $Db->prepare(qq(
   $SqlMarker select 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: $err\n");
   }
($OracleVersion) = $qry->fetchrow_array();
$qry->finish();
busy("all", "off");
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);
}

################################################################################

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 a popup dialog showing the structure of a table

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

# Create the dialog for displaying the object details
my $dialog = $PlanMain->Toplevel(-title => "Table");
my $box = $dialog->Frame(-borderwidth => 3, -relief => "raised");
$box->Label(-text => "$owner.$table",
            -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we");

# Mimic the SqlPlus "desc" command
$box->Label(-text => " Name ", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 1, -sticky => "we");
$box->Label(-text => " Type ", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 1, -row => 1, -sticky => "we");

# This will get the table description
busy("plan", "on");
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: $DBI::errstr\n");

# For each column in the table, display its details
my $row = 2;
while ((my ($name, $type, $length, $precision, $scale)
   = $qry->fetchrow_array()))
   {
   $box->Label(-text => "$name   ")
      ->grid(-column => 0, -row => $row, -sticky => "w");
   if ($precision)
      {
      $type .= "($precision";
      $type .= ",$scale" if ($scale);
      $type .= ")";
      }
   elsif ($type =~ /CHAR/)
      {
      $type .= "($length)";
      }
   $box->Label(-text => $type)
      ->grid(-column => 1, -row => $row, -sticky => "w");
   $row++;
   }
$qry->finish();
busy("plan", "off");

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

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

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

# Create the dialog for displaying the object details
my $dialog = $PlanMain->Toplevel(-title => "Index");
my $box = $dialog->Frame(-borderwidth => 3, -relief => "raised");
$box->Label(-text => "$owner.$index",
            -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we");

# Show the table columns the index is built upon
$box->Label(-text => " Table ", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 1, -sticky => "we");
$box->Label(-text => " Column ", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 1, -row => 1, -sticky => "we");
busy("plan", "on");
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: $DBI::errstr\n");

# For each column in the index, display its details
my $row = 2;
while ((my ($tab_owner, $table, $column) = $qry->fetchrow_array()))
   {
   $box->Label(-text => "$tab_owner.$table   ")
      ->grid(-column => 0, -row => $row, -sticky => "w");
   $box->Label(-text => $column)
      ->grid(-column => 1, -row => $row, -sticky => "w");
   $row++;
   }
$qry->finish();
busy("plan", "off");

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

################################################################################
# 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 .= "Id:\t$row->{ID}\tPosition:\t$row->{POSITION}\t"
       . "Parent Id:\t$row->{PARENT_ID}\n";
$info .= "Cost:\t$row->{COST}\tCardinality:\t$row->{CARDINALITY}\t"
       . "Bytes:\t\t$row->{BYTES}\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 .= "\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("plan", "on");
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: $DBI::errstr\n");
my ($object_type) = $qry->fetchrow_array();
$qry->finish();
busy("plan", "off");

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("plan", "on");
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: $DBI::errstr\n");
my ($object_type) = $qry->fetchrow_array();
$qry->finish();
if ($object_type ne "TABLE")
   {
   busy("plan", "off");
   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: $DBI::errstr\n");
my $menu = $PlanMain->Menu(-tearoff => 0, -disabledforeground => "#0000f0");
$menu->command(-label => "Indexes", -state => "disabled");
my $count = 0;
while ((my ($index_owner, $index_name) = $qry->fetchrow_array()))
   {
   $menu->command(-label => "$index_owner.$index_name",
                  -command => sub { disp_index($index_owner, $index_name); });
   $count++;
   }
$qry->finish();
busy("plan", "off");
$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 = "$SqlMarker explain plan set statement_id = '$$' for ";
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("plan", "on");
$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
        undef, $$)
   || die("Delete from plan_table: $DBI::errstr\n");
$Db->commit();

# Explain the plan
$Plan = { sql => $stmt };
$Db->do($prefix . $stmt) || die("Explain plan: $DBI::errstr\n");

# Read back the plan
my $qry = $Db->prepare($plan_sql)
   || die("Unsupported PLAN_TABLE format: $DBI::errstr\n");
$qry->execute($$) || die("Read plan: $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});
      $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("plan", "off");
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) = @_;

# Set up defaults
# 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->transient($parent);
   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");

   # Create the buttons & callbacks
   $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised");
   my $cb = sub
      {
      if (! eval { login($database, $username, $password); })
         {
         error($parent, $@);
         $LoginDialog->raise();
         }
      else
         {
         $LoginDialog->withdraw();
         }
      };
   $box->Button(-text => "Login", -command => $cb)
      ->pack(-side => "left", -expand => 1, -pady => 3);
   $box->Button(-text => "Cancel", -command => sub { $LoginDialog->withdraw() })
      ->pack(-side => "right", -expand => 1, -pady => 3);
   $box->pack(-expand => 1, -fill => "both");
   }
   
# Activate the dialog
$LoginDialog->Popup();
}

################################################################################
# Open a file and read it into the SQL editor frame

sub open_file($)
{
# Open the file
my ($file) = @_;
my $fh;
if (! ($fh = IO::File->new($file, "r")))
   {
   error("Cannot open $file", $!);
   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) = @_;

$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
$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("Cannot open $file", $!);
   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) = @_;
clear_editor();
$PlanSql->insert("end", $text->get("$tag.first", "$tag.last"));
explain();
}

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

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

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

# Read the info.  Note that the statement *may* have been purged from the cache!
$qry->execute($address);
my $info;
if (! (my ($sorts, $executions, $loads, $parse_calls,
           $disk_reads, $buffer_gets, $rows_processed)
   = $qry->fetchrow_array()))
   {
   $info = "This statement is no longer in the SQL cache";
   }
else
   {
   $info = "Sorts:\t\t$sorts\tExecutions:\t$executions\tLoads:\t\t$loads\n"
         . "Parse calls:\t$parse_calls\tDisk reads:\t$disk_reads\t"
         . "Buffer gets:\t$buffer_gets\nRows processed:\t$rows_processed";
   }
busy("grab", "off");

# Display the formated info
$GrabDetails->insert("1.0", $info);
return(1);
}

################################################################################
# Scan v$sqlarea for SQL statements matching the specified conditions.
#    $order_by is a v$sqlarea colum name used to rank the statements
#    $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 ($order_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");

# Define the callbacks for highlighting etc
my ($bold, $normal);
if ($GrabMain->depth > 1)
   {
   $bold = sub
      {
      my ($text, $tag) = @_;
      $text->tag("configure", $tag, -background => "#43ce80",
                 -relief => "raised", -borderwidth => 1);
      };
   $normal = sub
      {
      my ($text, $tag) = @_;
      $text->tag("configure", $tag, -background => undef, -relief => "flat");
      };
   }
else
   {
   $bold = sub
      {
      my ($text, $tag) = @_;
      $text->tag("configure", $tag, -foreground => "white",
                 -background => "black");
      };
   $normal = sub
      {
      my ($text, $tag) = @_;
      $text->tag("configure", $tag, -foreground => undef, -background => undef);
      };
   }
my $disp_cb = sub
   {
   my ($text, $address) = @_;
   if (! eval { disp_sql_cache_info($address); })
      { error($GrabMain, $@); }
   };

# Prepare the queries
busy("grab", "on");
my $qry1 = qq{$SqlMarker select address from v\$sqlarea};
$qry1 .= qq{, all_users} if ($user || $no_sys);
$qry1 .= qq{ where sql_text not like '\%$SqlMarker\%'};
$qry1 .= qq{ and sql_text not like 'insert into plan_table\%'};
$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);
$qry1 .= qq{ order by $order_by desc} if ($order_by);
$qry1 = $Db->prepare($qry1) || die("$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("$DBI::errstr\n");
   }
else{
   $qry2 = $Db->prepare(qq(
      $SqlMarker select sql_text from v\$sqltext
      where address = :1 order by piece))
      || die("$DBI::errstr\n");
   }

# For each SQL query in the shared pool...
if ($user) { $qry1->execute($user) || die("$DBI::errstr\n"); }
else { $qry1->execute() || die("$DBI::errstr\n"); }
my $count = 0;
while ($count != $rows && (my ($address) = $qry1->fetchrow_array()))
   {
   # ...glue together the components of the SQL string & print out
   $qry2->execute($address) || die("$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("bind", $address, "<Any-Enter>" => [ $bold, $address ]);
   $GrabSql->tag("bind", $address, "<Any-Leave>" => [ $normal, $address ]);
   $GrabSql->tag("bind", $address, "<Double-1>" => [ \&copy_sql, $address]);
   $GrabSql->tag("bind", $address, "<1>" => [ $disp_cb, $address ]);
   $GrabSql->update();

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

# Clean up
$qry1->finish();
$GrabFeedback->configure(-text => "$count queries grabbed");
busy("grab", "off");
return(1);
}

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

sub grab_main
{
# Only create if it doesn't already exist
return if ($GrabMain);
$GrabMain = $PlanMain->Toplevel(-title => "explain - SQL cache");

### 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 => "Close", -underline => 1,
   -command => sub { $GrabMain->destroy(); });
$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);
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame1 = $frame->Frame(-highlightthickness => 0);
$frame1->Label(-text => "SQL Cache")->pack(-side => "left");
$GrabFeedback = $frame1->Label(-text => "", -foreground => "#ff0000")
   ->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 => 3, -width => 80, -borderwidth => 0,
                              -setgrid => "true", -wrap => "word")
   ->pack(-fill => "x");
$frame->pack(-fill => "x");

### SQL selection
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "SQL Selection Criterea")->pack(-anchor => "nw");

$frame1 = $frame->Frame(-highlightthickness => 1);
$frame1->Label(-text => "Order SQL by number of:")
   ->grid(-column => 0, -row => 0, -columnspan => 3, -sticky => "w");
my $order_by = "disk_reads";
$frame1->Radiobutton(-text => "Disk reads", -highlightthickness => 0,
                    -value => "disk_reads", -variable => \$order_by)
   ->grid(-column => 0, -row => 1, -sticky => "w");
$frame1->Radiobutton(-text => "Buffer gets", -highlightthickness => 0,
                    -value => "buffer_gets", -variable => \$order_by)
   ->grid(-column => 1, -row => 1, -sticky => "w");
$frame1->Radiobutton(-text => "Rows processed", -highlightthickness => 0,
                    -value => "rows_processed", -variable => \$order_by)
   ->grid(-column => 2, -row => 1, -sticky => "w");
$frame1->Radiobutton(-text => "Executions", -highlightthickness => 0,
                    -value => "executions", -variable => \$order_by)
   ->grid(-column => 3, -row => 1, -sticky => "w");
$frame1->Radiobutton(-text => "Parse calls", -highlightthickness => 0,
                    -value => "parse_calls", -variable => \$order_by)
   ->grid(-column => 0, -row => 2, -sticky => "w");
$frame1->Radiobutton(-text => "Sorts", -highlightthickness => 0,
                    -value => "sorts", -variable => \$order_by)
   ->grid(-column => 1, -row => 2, -sticky => "w");
$frame1->Radiobutton(-text => "Loads", -highlightthickness => 0,
                    -value => "loads", -variable => \$order_by)
   ->grid(-column => 2, -row => 2, -sticky => "w");
$frame1->Radiobutton(-text => "No ordering", -highlightthickness => 0,
                    -value => "", -variable => \$order_by)
   ->grid(-column => 3, -row => 2, -sticky => "w");

my $no_sys = 1;
$frame1->Checkbutton(-text => "Exclude queries by SYS or SYSTEM",
                     -variable => \$no_sys, -offvalue => 0, -onvalue => 1,
                     -highlightthickness => 0)
   ->grid(-column => 0, -row => 3, -sticky => "w", -columnspan => 3);


my $user = "";
$frame1->Label(-text => "First user to execute statement")
   ->grid(-column => 0, -row => 4, -sticky => "w", -columnspan => 2);
$frame1->Entry(-textvariable => \$user, -width => 30)
   ->grid(-column => 2, -row => 4, -sticky => "w", -columnspan => 2);

my $pattern = "";
$frame1->Label(-text => "SQL matches pattern")
   ->grid(-column => 0, -row => 5, -sticky => "w", -columnspan => 2);
$frame1->Entry(-textvariable => \$pattern, -width => 30)
   ->grid(-column => 2, -row => 5, -sticky => "w", -columnspan => 2);

my $rows = 100;
$frame1->Label(-text => "Maximum number of statements")
   ->grid(-column => 0, -row => 6, -sticky => "w", -columnspan => 2);
$frame1->Entry(-textvariable => \$rows, -width => 4)
   ->grid(-column => 2, -row => 6, -sticky => "w", -columnspan => 2);

$frame1->pack(-fill => "x");
$frame->pack(-fill => "x");

### Buttons
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
my $grab_cb = sub
   {
   if (! eval { grab($order_by, $no_sys, $user, $pattern, $rows); })
      { error($GrabMain, $@); }
   };
$frame->Button(-text => "Grab", -command => $grab_cb)
   ->pack(-side => "left", -expand => 1, -pady => 3);
$frame->Button(-text => "Close", -command => sub { $GrabMain->destroy(); })
   ->pack(-side => "left", -expand => 1, -pady => 3);
$frame->pack(-fill => "x");
#$GrabMain->bind("<Destroy>", sub { $GrabMain = undef; });
$GrabMain->OnDestroy(sub { $GrabMain = undef; });
}

################################################################################
# Main

### Main window
$PlanMain = MainWindow->new();
$PlanMain->title("explain");

### Menubar
my $menubar = $PlanMain->Frame(-relief => "raised", -borderwidth => 3);
$menubar->pack(-fill => "x");

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 => "Grab SQL ...", -underline => 0,
   -command => sub { 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");

### 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 => 10, -width => 80,
                             -borderwidth => 0, -wrap => "word",
                             -setgrid => "true", -scrollbars => "oe")
   ->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 => 3);
$frame->Button(-text => "Clear", -command => \&clear_editor)
   ->pack(-side => "left", -expand => 1, -pady => 3);
$frame->Button(-text => "Grab", -command => \&grab_main)
   ->pack(-side => "left", -expand => 1, -pady => 3);
$frame->pack(-fill => "x");

### user/pass@db command-line argument processing
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); });
   }
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__

=head1 NAME

explain, ora_explain - visualise Oracle query plans

=head1 SYNOPSIS

 $ explain [ [ user/password@database ] sql script ]
 $ ora_explain [ [ 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 statemant 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 grab 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 0.93 or later

=item 4.

L<DBD::Oracle> 0.49 or later

=item 5.

L<Tk|Tk::overview> 8.005 or later

=item 6.

L<Tk::Pod> 3.15 or later

=back

Items 2 through 6 can be obtained from any CPAN mirror.

=head1 INSTALLATION

=over 2

=item 1.

Check you have all the prequisites installed and working.

=item 2.

Check the #! line in the script points to where your Perl interpreter is
installed.

=item 3.

Copy the "explain" script to somewhere on your path.

=item 4.

Make sure the "explain" script is executable.

=item 5.

Make sure you have run the script $ORACLE_HOME/rdbms/admin/utlxplan.sql
from a SQL*Plus session.  This script creates the PLAN_TABLE that is used
by Oracle when explaining query plans.

=back

=head1 HOW TO USE

Type "explain" 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 is a single button labelled "Explain".  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 one pulldown menu, "File", which allows you to login to Oracle,
Grab the contents of the Oracle SQL cache, Load SLQ from files, Save SQL to
files and to Exit the program.

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.

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.

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 Grab functionality

The explain window has an option on the "File" menu labelled "Grab SQL ...".
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 Criterea".  At the bottom of the window is a single button labelled
"Grab".

The menu bar has one pulldown menu, "File", which allows you to Save the
contents of the SQL Cache frame and Close the Grab window.

The "SQL Cache" frame shows the statements currently in the Oracle SQL cache.
Text may be saved by using the "File" pulldown menu.

The "SQL Selection Criterea" 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
criterea, clicking the "Grab" button will read all the matching statements from
the SQL cache and display them in the top frame.

Single-clicking on a statement in the SQL Cache pane will display more
detailed information on that statement in the Sql Statement Statistics frame,
including the number of times the statement has been executed and the numbers
of rows processed by the statement.

Double-clicking on a statement will copy it into the SQL editor in the Explain
window, so that the query plan for the statement can be examined.

=head1 SUPPORT

Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com

=head1 COPYRIGHT AND DISCLAIMER 

Copyright (c) 1998 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, with the
exception that it cannot be placed on a CD-ROM or similar media for commercial
distribution without the prior approval of the author.

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
SCRIPT

use Config;

my $file = __FILE__; $file =~ s/\.PL$//;

$script =~ s/\~(\w+)\~/$Config{$1}/eg;
if (!(open(FILE, ">$file"))  ||
    !(print FILE $script)  ||
    !(close(FILE))) {
    die "Error while writing $file: $!\n";
}
print "Extracted $file from ",__FILE__," with variable substitutions.\n";

# End.
