# -*- 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::Dialog;
use Tk::FileSelect;
use Tk::ROText;
use Tk::Tree;

use vars qw($VERSION);
$VERSION = "0.6 beta";

# 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
#   $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 $GrabSql $GrabDetails);
$SqlMarker = '/* This statement was generated by explain */';

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

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

################################################################################
# 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) = @_;

# 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();
}

################################################################################
# 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 the query plan tree

sub disp_plan_tree()
{
$PlanTitle->configure(-text => $Plan->{title});
$PlanTree->delete('all');
foreach my $step (@{$Plan->{id}})
   {
   $PlanTree->add($step->{key}, -text => $step->{desc});
   }
$PlanTree->autosetmode();
}

################################################################################
# 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
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();
$object_type = ucfirst(lc($object_type));

# We only know about Tables and Indexes
if ($object_type ne 'Table' && $object_type ne 'Index')
   {
   die("Unknown object type $object_type",
       "for $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}\n");
   }

# Create the dialog for displaying the object details
my $dialog = $PlanMain->Toplevel(-title => $object_type);
my $box = $dialog->Frame(-borderwidth => 2, -relief => 'raised');
$box->Label(-text => "$row->{OBJECT_OWNER}.$row->{OBJECT_NAME}",
            -relief => 'ridge', -borderwidth => 1)
   ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => 'we');

# For tables we mimic the SqlPlus 'desc' command
if ($object_type eq 'Table')
   {
   $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
   $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($row->{OBJECT_OWNER}, $row->{OBJECT_NAME})
      || 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();
   }

# For indexes we show the table columns the index is built upon
else
   {
   $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');
   $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($row->{OBJECT_OWNER}, $row->{OBJECT_NAME})
      || die("Index columns: $DBI::errstr\n");

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

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

################################################################################
# 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 ";
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
$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();
}

################################################################################
# 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');
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";
   }

# 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
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 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...
$PlanMain->Busy();
$GrabMain->Busy();
if ($user) { $qry1->execute($user) || die("$DBI::errstr\n"); }
else { $qry1->execute() || die("$DBI::errstr\n"); }
while ($rows != 0
   && (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();

   $rows--;
   }

# Clean up
$qry1->finish();
$GrabMain->Unbusy();
$PlanMain->Unbusy();
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 => 2);
$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');

### SQL cache display
my $frame;
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => 'raised');
$frame->Label(-text => 'SQL Cache')->pack(-anchor => 'nw');
$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');

my $frame1 = $frame->Frame(-highlightthickness => 2);
$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 => 'Sorts', -highlightthickness => 0,
                    -value => 'sorts', -variable => \$order_by)
   ->grid(-column => 0, -row => 2, -sticky => 'w');
$frame1->Radiobutton(-text => 'Loads', -highlightthickness => 0,
                    -value => 'loads', -variable => \$order_by)
   ->grid(-column => 1, -row => 2, -sticky => 'w');
$frame1->Radiobutton(-text => 'No ordering', -highlightthickness => 0,
                    -value => '', -variable => \$order_by)
   ->grid(-column => 2, -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 => 2);
$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');

### Query plan tree
my $frame;
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => 'raised');
$PlanTitle = $frame->Label(-text => 'Query Plan')->pack(-anchor => 'nw');
my $cb = sub { error($PlanMain, $@) if (! eval { disp_plan_step_obj($_[0])}); };
$PlanTree = $frame->Scrolled('Tree', -height => 15, -width => 80,
                         -borderwidth => 0, -scrollbars => 'osoe',
                         -browsecmd => \&disp_plan_step,
                         -command => $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();

################################################################################
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.
