DBD-Oracle
view release on metacpan or search on metacpan
examples/ora_explain.pl view on Meta::CPAN
}
}
}
# Top of the tree is step 0
$Plan->{tree} = $Plan->{id}[0];
# Clean up
$qry->finish();
$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
undef, $$);
$Db->commit();
busy(0);
return(1);
}
################################################################################
# Wrapper for _explain - adds error handling
sub explain
{
clear_plan();
if (! eval { _explain(); }) { error($PlanMain, $@); }
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);
}
examples/ora_explain.pl view on Meta::CPAN
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>" => [ \©_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); });
( run in 3.115 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )