Menu results from the CPAN

DBD-Oracle

my $qry = $Db->prepare(qq(
   $SqlMarker select object_type from all_objects
   where object_name = :1 and owner = :2
));
$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
   || die("Object type:\n$DBI::errstr\n");
my ($object_type) = $qry->fetchrow_array();
$qry->finish();
busy(0);

if ($object_type eq "TABLE")
   {
   disp_table($row->{OBJECT_OWNER}, $row->{OBJECT_NAME});
   }
elsif ($object_type eq "INDEX")
   {
   disp_index($row->{OBJECT_OWNER}, $row->{OBJECT_NAME});
   }
else
   {
   die("Unknown object type $object_type",
       "for $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}\n");
   }
}

################################################################################
# Display a list of available indexes on a table, and display the selected
# table definition

sub disp_index_popup($)
{
my ($key) = @_;

# Get the plan step & return if it doesn't refer to an object
my $row = $Plan->{key}{$key};
return(1) if (! $row->{OBJECT_NAME});

# Work out the type of the object - table or index
busy(1);
my $qry = $Db->prepare(qq(
   $SqlMarker select object_type from all_objects
   where object_name = :1 and owner = :2
));
$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
   || die("Object type:\n$DBI::errstr\n");
my ($object_type) = $qry->fetchrow_array();
$qry->finish();
if ($object_type ne "TABLE")
   {
   busy(0);
   return(1);
   }

# Build the popup menu
$qry = $Db->prepare(qq(
   $SqlMarker select owner, index_name from all_indexes
   where table_name = :1 and table_owner = :2
));
$qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER})
   || die("Table indexes:\n$DBI::errstr\n");
my $menu = $PlanMain->Menu(-tearoff => 0, -disabledforeground => "#000000");
$menu->command(-label => "Indexes", -state => "disabled");
               
$menu->separator();
my $count = 0;
while ((my ($index_owner, $index_name) = $qry->fetchrow_array()))
   {
   $menu->command(-label => "$index_owner.$index_name",
                  -command => [ \&disp_index, $index_owner, $index_name ]);
   $count++;
   }
$qry->finish();
busy(0);
$menu->Popup(-popover => "cursor", -popanchor => "nw") if ($count);
return(1);
}

################################################################################
# Produce the query plan for the SQL in $PlanSql and store it in $Plan

sub _explain()
{
# Check there is some SQL
my $stmt = $PlanSql->get("1.0", "end");
$stmt =~ s/;//g;
die("You have not supplied any SQL\n") if ($stmt =~ /^\s*$/);

# Check we are logged on
die("You are not logged on to Oracle\n") if (! $Db);

# Set up the various query strings
# Note that for some reason you can't use bind variables in 'explain plan'
my $prefix = "explain plan set statement_id = '$$' for\n";
my $plan_sql = qq(
   $SqlMarker select level, operation, options, object_node, object_owner,
      object_name, object_instance, object_type, id, parent_id, position,
      other);
if ($OracleVersion ge "7.3")
   { $plan_sql .= qq(, cost, cardinality, bytes, other_tag) };
if ($OracleVersion ge "8")
   { $plan_sql .= qq(, partition_start, partition_stop, partition_id) };
$plan_sql .= qq(
  from plan_table
  where statement_id = :1
  connect by prior id = parent_id and statement_id = :1
  start with id = 0 and statement_id = :1
);

# Clean any old stuff from the plan_table
busy(1);
$Db->do(qq($SqlMarker delete from plan_table where statement_id = :1),
        undef, $$)
   || die("Delete from plan_table:\n$DBI::errstr\n");
$Db->commit();

# Switch schema if required
if ($Schema ne $User)
   {
   $Db->do(qq($SqlMarker alter session set current_schema = $Schema))
      || die("Cannot change schema to $Schema:\n$DBI::errstr\n");
   }

examples/ora_explain.pl view on Meta::CPAN

if ($GrabMain)
   {
   $GrabMain->deiconify();
   $GrabMain->raise($PlanMain);
   return;
   }

# Otherwise, build the grab window
$GrabMain = $PlanMain->Toplevel(-title => "$ProgName - SQL cache");
$GrabMain->protocol("WM_DELETE_WINDOW", sub { $GrabMain->withdraw(); });

# Defaults & callbacks
my $ordering = "";
my $order_by = "";
my $sort_by  = "";
my $no_sys   = 1;
my $user     = "";
my $pattern  = "";
my $rows     = 100;
my $grab_cb = sub
   {
   if (! eval { grab($ordering, $order_by, $sort_by, $no_sys,
                     $user, $pattern, $rows); })
      { error($GrabMain, $@); }
   };
my (%ord_bn, %sort_bn);   # For "order by" and "sort order" buttons
my $ord_bn_cb = sub
   {
   if ($ordering eq "")
      {
      $order_by = "";
      $sort_by = "";
      foreach my $bn (values(%ord_bn))
         { $bn->configure(-state => "disabled"); }
      foreach my $bn (values(%sort_bn))
         { $bn->configure(-state => "disabled"); }
      }
   elsif ($ordering eq "total")
      {
      $order_by = "disk_reads" if ($order_by eq "");
      $sort_by = "desc" if ($sort_by eq "");
      foreach my $bn (values(%ord_bn))
         { $bn->configure(-state => "normal"); }
      foreach my $bn (values(%sort_bn))
         { $bn->configure(-state => "normal"); }
      }
   else # $ordering eq "average"
      {
      $order_by = "disk_reads"
         if ($order_by eq "" || $order_by eq "executions");
       $sort_by = "desc" if ($sort_by eq "");
      foreach my $bn (values(%ord_bn))
         { $bn->configure(-state => "normal"); }
      $ord_bn{executions}->configure(-state => "disabled");
      $ord_bn{first_load_time}->configure(-state => "disabled");
      foreach my $bn (values(%sort_bn))
         { $bn->configure(-state => "normal"); }
      }
   };

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

my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0);
$menubar_file->command(-label => "Save File ...", -underline => 0,
   -command => sub { save_dialog($PlanMain, $GrabSql); });
$menubar_file->separator();
$menubar_file->command(-label => "Capture SQL", -underline => 0,
   -command => $grab_cb);
$menubar_file->command(-label => "Copy to Explain", -underline => 9,
   -command => sub { copy_sql($GrabSql, $GrabSelection); });
$menubar_file->command(-label => "Close", -underline => 1,
   -command => sub { $GrabMain->withdraw(); });
$menubar_file->pack(-side => "left");

my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0);
$menubar_help->command(-label => "About ...", -underline => 0,
   -command => sub { about($GrabMain); });
$menubar_help->command(-label => "Usage ...", -underline => 0,
   -command => sub { help($GrabMain); });
$menubar_help->pack(-side => "right");

### SQL cache display
my ($frame, $frame1, $frame2, $frame3);
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame1 = $frame->Frame(-highlightthickness => 0);
$frame1->Label(-text => "SQL Cache")->pack(-side => "left");
$GrabStatus = $frame1->Label(-text => "")->pack(-side => "right");
$frame1->pack(-fill => "x");
$GrabSql = $frame->Scrolled("ROText", -setgrid => "true", -scrollbars => "oe",
                            -height => 15, -width => 80, -borderwidth => 0,
                            -wrap => "word")
   ->pack(-fill => "both", -expand => 1);
$frame->pack(-fill => "both", -expand => 1);

### SQL statement details
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "SQL Statement Statistics")->pack(-anchor => "nw");
$GrabDetails = $frame->ROText(-height => 7, -width => 80, -borderwidth => 0,
                              -setgrid => "true", -wrap => "none")
   ->pack(-fill => "x");
$GrabDetails->tagConfigure("bold", -font => "bold");
$frame->pack(-fill => "x");

### SQL selection
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "SQL Selection Criteria")->pack(-anchor => "w");
$frame1 = $frame->Frame(-highlightthickness => 1);

## SQL sort frame
$frame1->Label(-text => "Order SQL by")
   ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2);
$frame2 = $frame1->Frame(-highlightthickness => 0);

# Ordering frame
$frame3 = $frame2->Frame(-highlightthickness => 1);
$frame3->Radiobutton(-text => "No ordering", -highlightthickness => 0,
                     -value => "", -variable => \$ordering,
                     -command => $ord_bn_cb)
   ->pack(-anchor => "w");
$frame3->Radiobutton(-text => "Total", -highlightthickness => 0,
                    -value => "total", -variable => \$ordering,
                    -command => $ord_bn_cb)
   ->pack(-anchor => "w");
$frame3->Radiobutton(-text => "Average per execution",
                     -highlightthickness => 0, -value => "average",
                     -variable => \$ordering, -command => $ord_bn_cb)
   ->pack(-anchor => "w");
$frame3->pack(-side => "left", -padx => 6);

# Order by frame
$frame3 = $frame2->Frame(-highlightthickness => 1);
$ord_bn{disk_reads} =
   $frame3->Radiobutton(-text => "Disk reads", -highlightthickness => 0,
                        -value => "disk_reads", -variable => \$order_by,
                        -command => $ord_bn_cb)

examples/ora_explain.pl view on Meta::CPAN


## Other options frame
$frame2 = $frame1->Frame(-highlightthickness => 0);
$frame2->Checkbutton(-text => "Exclude queries by SYS or SYSTEM",
                     -variable => \$no_sys, -offvalue => 0, -onvalue => 1,
                     -highlightthickness => 0)
   ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2);
$frame2->Label(-text => "First user to execute statement")
   ->grid(-column => 0, -row => 1, -sticky => "w");
$frame2->Entry(-textvariable => \$user, -width => 30)
   ->grid(-column => 1, -row => 1, -sticky => "w");
$frame2->Label(-text => "SQL matches pattern")
   ->grid(-column => 0, -row => 2, -sticky => "w");
$frame2->Entry(-textvariable => \$pattern, -width => 30)
   ->grid(-column => 1, -row => 2, -sticky => "w");
$frame2->Label(-text => "Maximum number of statements")
   ->grid(-column => 0, -row => 3, -sticky => "w");
$frame2->Entry(-textvariable => \$rows, -width => 4)
   ->grid(-column => 1, -row => 3, -sticky => "w");
$frame2->grid(-column => 0, -row => 2, -sticky => "we",
              -columnspan => 2, -padx => 6, -pady => 6);
$frame1->pack(-fill => "x");
&$ord_bn_cb();   # Set the buttons to the initial state
$frame->pack(-fill => "x", -padx => 6, -pady => 6);

### Buttons
$frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Button(-text => "Capture SQL", -command => $grab_cb)
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->Button(-text => "Copy to Explain",
               -command => sub { copy_sql($GrabSql, $GrabSelection); })
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->Button(-text => "Close", -command => sub { $GrabMain->withdraw(); })
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->pack(-fill => "x");
}

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

### Main window
$ProgName = basename($0);
$ProgName =~ s/\..*$//;
$PlanMain = MainWindow->new();
$PlanMain->withdraw();
update_title();
$Balloon = $PlanMain->Balloon();

### Splash screen
my $splash;
if (@ARGV == 0 || $ARGV[0] ne '-q')
   {
   about($PlanMain, \$splash);
   $splash->after(10000,
                  sub { if ($splash) { $splash->destroy(); undef($splash); } });
   $PlanMain->update();
   }
else
   { shift(@ARGV); }

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

# Create a bold font $ figure out charcter spacing
my $t = $PlanMain->Text();
my $f = $t->cget(-font);
$t->fontCreate("bold", $PlanMain->fontActual($f), -weight => "bold");
$CharWidth = $PlanMain->fontMeasure($f, "X");
undef($f);
$t->destroy();
undef($t);

my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0);
$menubar_file->command(-label => "Login ...", -underline => 0,
   -command => sub { login_dialog($PlanMain); });
$menubar_file->command(-label => "Schema ...", -underline => 2,
   -command => sub { schema_dialog($PlanMain); });
$menubar_file->command(-label => "Explain", -underline => 0,
   -command => \&explain);
$menubar_file->command(-label => "SQL Cache ...", -underline => 4,
   -command => \&grab_main);
$menubar_file->separator();
$menubar_file->command(-label => "Open File ...", -underline => 0,
   -command => sub { open_dialog($PlanMain); });
$menubar_file->command(-label => "Save File ...", -underline => 0,
   -command => sub { save_dialog($PlanMain, $PlanSql); });
$menubar_file->separator();
$menubar_file->command(-label => "Exit", -underline => 1,
   -command => sub { $Db->disconnect() if ($Db); exit(0); });
$menubar_file->pack(-side => "left");

my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0);
$menubar_help->command(-label => "About ...", -underline => 0,
   -command => sub { about($PlanMain); });
$menubar_help->command(-label => "Usage ...", -underline => 0,
   -command => sub { help($PlanMain); });
$menubar_help->pack(-side => "right");
$menubar->pack(-fill => "x");

### Query plan tree
my $frame;
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
$PlanTitle = $frame->Label(-text => "Query Plan")->pack(-anchor => "nw");
my $b1_cb = sub
   { error($PlanMain, $@) if (! eval { disp_plan_step_obj($_[0])}); };
my $b3_cb = sub
   { error($PlanMain, $@) if (! eval { disp_index_popup($_[0])}); };
$PlanTree = $frame->Scrolled("B3Tree", -height => 15, -width => 80,
                             -borderwidth => 0, -highlightthickness => 1,
                             -scrollbars => "osoe",
                             -browsecmd => \&disp_plan_step,
                             -command => $b1_cb, -b3command => $b3_cb)
   ->pack(-expand => 1, -fill => "both");
$frame->pack(-expand => 1, -fill => "both");

### Query plan statement details
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "Query Step Details")->pack(-anchor => "nw");
$PlanStep = $frame->Scrolled("ROText", -height => 8, -width => 80,
                             -borderwidth => 0, -wrap => "none",
                             -setgrid => "true", -scrollbars => "osoe")
   ->pack(-fill => "x");
$frame->pack(-fill => "x");

### SQL text editor
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Label(-text => "SQL Editor")->pack(-anchor => "nw");
$PlanSql = $frame->Scrolled("Text", -setgrid => "true", -scrollbars => "oe",
                            -borderwidth => 0, -height => 15, -width => 80,
                            -wrap => "word")
   ->pack(-expand => 1, -fill => "both");
$frame->pack(-expand => 1, -fill => "both");

### Buttons
$frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised");
$frame->Button(-text => "Explain", -command => \&explain)
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->Button(-text => "Clear", -command => \&clear_editor)
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->Button(-text => "SQL Cache", -command => \&grab_main)
   ->pack(-side => "left", -expand => 1, -pady => 6);
$frame->pack(-fill => "x");

### user/pass@db command-line argument processing
$PlanMain->update();
$PlanMain->deiconify();
$splash->raise() if (defined($splash));
if (@ARGV >= 1 && $ARGV[0] =~ /\w*\/\w*(@\w+)?/)
   {
   my ($username, $password, $database) = split(/[\/@]/, shift(@ARGV));
   if (! $username) { $username = "/"; $password = ""; }
   if (! $database) { $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID}; }

( run in 1.696 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )