DBD-Oracle

 view release on metacpan or  search on metacpan

examples/ora_explain.pl  view on Meta::CPAN

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

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

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

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

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

my ($msg, $height, $width);
$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;

examples/ora_explain.pl  view on Meta::CPAN

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.

examples/ora_explain.pl  view on Meta::CPAN

   {
   $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;

examples/ora_explain.pl  view on Meta::CPAN

       "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",

examples/ora_explain.pl  view on Meta::CPAN

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

examples/ora_explain.pl  view on Meta::CPAN

   $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

examples/ora_explain.pl  view on Meta::CPAN

$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"

examples/ora_explain.pl  view on Meta::CPAN

   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(

examples/ora_explain.pl  view on Meta::CPAN

   {
   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(

examples/ora_explain.pl  view on Meta::CPAN

   }
$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

examples/ora_explain.pl  view on Meta::CPAN

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};

examples/ora_explain.pl  view on Meta::CPAN

   $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

examples/ora_explain.pl  view on Meta::CPAN

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

examples/ora_explain.pl  view on Meta::CPAN

   {
   $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",

examples/ora_explain.pl  view on Meta::CPAN

$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)
   {

examples/ora_explain.pl  view on Meta::CPAN

   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

examples/ora_explain.pl  view on Meta::CPAN

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

t/28array_bind.t  view on Meta::CPAN

        FetchHashKeyName => 'NAME_lc',
        ora_envhp => 0,    # force fresh environment (with current NLS env vars)
    };
    $p->{ora_charset}  = $charset  if $charset;
    $p->{ora_ncharset} = $ncharset if $ncharset;

    my $dbh = db_handle( $p );
    return $dbh;
}

sub test_varchar2_table_3_tests($) {
    my $dbh       = shift;
    my $statement = q|
        DECLARE
                tbl SYS.DBMS_SQL.VARCHAR2_TABLE;
        BEGIN
                tbl := :mytable;
                :cc := tbl.count();
                tbl(1) := 'def';
                tbl(2) := 'ijk';
                :mytable := tbl;