view release on metacpan or  search on metacpan

examples/ora_explain.pl  view on Meta::CPAN

   }
($User, $OracleVersion) = $qry->fetchrow_array();
$qry->finish();
$DbName = $database || $ENV{TWO_TASK} || $ENV{ORACLE_SID};
$Schema = $User;

# Check there is a plan_table for this user
$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 $User does not have a PLAN_TABLE.\n",
       "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",
                 -borderwidth => 1)
   ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we",
          -ipadx => 3);
$index_fr->Label(-text => "Table", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3);
$index_fr->Label(-text => "Column", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3);

# Show the table columns the index is built upon
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:\n$DBI::errstr\n");

# For each column in the index, display its details
my ($tab_txt, $col_txt);
while ((my ($tab_owner, $table, $column) = $qry->fetchrow_array()))
   {
   $tab_txt .= "$tab_owner.$table\n";
   $col_txt .= "$column\n";
   }
$qry->finish();
chop($tab_txt, $col_txt);
$index_fr->Label(-text => $tab_txt, -relief => "ridge", -borderwidth => 1,
                 -justify => "left")
   ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3);
$index_fr->Label(-text => $col_txt, -relief => "ridge", -borderwidth => 1,
                 -justify => "left")
   ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3);
$index_fr->pack(-side => "top", -fill => "x");

# Pack the grid and add the close button
$dialog->Button(-text => "Close", -command => sub { $dialog->destroy(); })
   ->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
      from all_indexes
      where table_owner = :1 and table_name = :2
   order by owner, index_name
   ));

   # Build up a list of all the indexes
   $qry->execute($owner, $table) || die("Table indexes:\n$DBI::errstr\n");
   my (@indexes, $ind_owner, $ind_name);
   while (($ind_owner, $ind_name) = $qry->fetchrow_array())
      { push(@indexes, { owner => $ind_owner, name => $ind_name }); }
   $qry->finish();

   # Special for no indexes
   if (@indexes == 0)
      {
      $index_fr->Label(-text => "No\nindexes\ndefined", -relief => "ridge",
                       -borderwidth => 1)->pack(-ipadx => 3, -ipady => 4);
      }
   else
      {
      # Do the header label
      $index_fr->Label(-text => "Index\norder", -relief => "ridge",
                       -borderwidth => 1)
         ->grid(-column => 0, -row => 0, -sticky => "we", -ipadx => 3,
                -ipady => 2, -columnspan => scalar(@indexes), -rowspan => 2);

      # This will retrieve (table column id, index position) for an index
      $qry = $Db->prepare(qq(
         $SqlMarker select atc.column_id, aic.column_position
         from all_tab_columns atc, all_ind_columns aic
         where aic.index_owner = :1 and aic.index_name = :2
         and atc.owner = aic.table_owner and atc.table_name = aic.table_name
         and atc.column_name = aic.column_name
         order by aic.index_name, atc.column_id
      ));

      # For each index, add a label describing the index
      my $cb = sub { disp_index($_[1], $_[2]); };
      my $grid_col = 0;
      foreach my $index (@indexes)
         {
         ($ind_owner, $ind_name) = @{$index}{qw(owner name)};
         $qry->execute($ind_owner, $ind_name)
            || die("Index columns:\n$DBI::errstr\n");
         my $index_txt;
         my $col = 1;
         while (my ($col_id, $col_pos) = $qry->fetchrow_array())
            {
            $index_txt .= "\n" x ($col_id - $col) . "$col_pos\n";
            $col = $col_id + 1;
            }
         $index_txt .= "\n" x ($num_cols - ($col - 1));
         chop($index_txt);
         my $label = $index_fr->Label(-text => $index_txt, -relief => "ridge",
                                      -borderwidth => 1, -justify => "left")
            ->grid(-column => $grid_col, -row => 2, -sticky => "w",
                   -ipadx => 3);
         $label->bind("<1>", [ $cb, $ind_owner, $ind_name ]);
         $Balloon->attach($label, -msg => "$ind_owner.$ind_name",
                          -balloonposition => "mouse");
         $grid_col++;
         }
      }
   }
if ($index_bn->cget(-text) eq "Indexes")
   {
   $index_bn->configure(-text => "Hide Indexes");
   $index_fr->pack(-side => "right", -expand => 1);
   }
else
   {
   $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
my $box1 = $dialog->Frame(-borderwidth => 3, -relief => "raised");
my $box2 = $box1->Frame(-borderwidth => 0);
my $table_fr = $box2->Frame(-borderwidth => 1, -relief => "flat");
$table_fr->Label(-text => "$owner.$table",
            -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we");
$table_fr->Label(-text => "Name", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3);
$table_fr->Label(-text => "Type", -relief => "ridge", -borderwidth => 1)
   ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3);

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

my ($num_cols, $name_txt, $type_txt);
while ((my ($name, $type, $length, $precision, $scale)
   = $qry->fetchrow_array()))
   {
   if ($precision)
      {
      $type .= "($precision";
      $type .= ",$scale" if ($scale);
      $type .= ")";
      }
   elsif ($type =~ /CHAR/)
      {
      $type .= "($length)";
      }
   $name_txt .= "$name\n";
   $type_txt .= "$type\n";
   $num_cols++;
   }
$qry->finish();
chop($name_txt, $type_txt);
$table_fr->Label(-text => $name_txt, -relief => "ridge", -borderwidth => 1,
                 -justify => "left")
   ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3);
$table_fr->Label(-text => $type_txt, -relief => "ridge", -borderwidth => 1,
                 -justify => "left")
   ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3);
$table_fr->pack(-side => "left");

# Now create a frame for the index definition & pack the whole lot
my $index_fr = $box2->Frame(-borderwidth => 1, -relief => "flat");
$box2->pack();
$box1->pack(-side => "top", -fill => "x", -expand => 1);

# Create the buttons at the bottom
$box1 = $dialog->Frame(-borderwidth => 0);
$box1->Button(-text => "Close", -command => sub { $dialog->destroy(); })
   ->pack(-padx => 6, -side => "left", -expand => 1);
my $index_bn;
$index_bn = $box1->Button(-text => "Indexes")
   ->pack(-padx => 6, -side => "left", -expand => 1);
$index_bn->configure(-command => sub { disp_table_cb($owner, $table, $num_cols,
                                                     $index_fr, $index_bn); });
$box1->pack(-side => "bottom", -pady => 6);

examples/ora_explain.pl  view on Meta::CPAN

         { $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)
      ->grid(-column => 0, -row => 0, -sticky => "w");
$ord_bn{buffer_gets} =
   $frame3->Radiobutton(-text => "Buffer gets", -highlightthickness => 0,
                        -value => "buffer_gets", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 1, -row => 0, -sticky => "w");
$ord_bn{rows_processed} =
   $frame3->Radiobutton(-text => "Rows processed", -highlightthickness => 0,
                        -value => "rows_processed", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 1, -sticky => "w");
$ord_bn{sorts} =
   $frame3->Radiobutton(-text => "Sorts", -highlightthickness => 0,
                        -value => "sorts", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 1, -row => 1, -sticky => "w");
$ord_bn{loads} =
   $frame3->Radiobutton(-text => "Loads", -highlightthickness => 0,
                        -value => "loads", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 2, -sticky => "w");
$ord_bn{parse_calls} =
   $frame3->Radiobutton(-text => "Parse calls", -highlightthickness => 0,
                        -value => "parse_calls", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 1, -row => 2, -sticky => "w");
$ord_bn{executions} =
   $frame3->Radiobutton(-text => "Executions", -highlightthickness => 0,
                        -value => "executions", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 3, -sticky => "w");
$ord_bn{first_load_time} =
   $frame3->Radiobutton(-text => "First load", -highlightthickness => 0,
                        -value => "first_load_time", -variable => \$order_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 1, -row => 3, -sticky => "w");
$frame3->pack(-side => "left", -padx => 6);

# Sort order frame
$frame3 = $frame2->Frame(-highlightthickness => 1);
$sort_bn{desc} =
   $frame3->Radiobutton(-text => "Descending", -highlightthickness => 0,
                        -value => "desc", -variable => \$sort_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 0, -sticky => "w");
$sort_bn{asc} =
   $frame3->Radiobutton(-text => "Ascending", -highlightthickness => 0,
                        -value => "asc", -variable => \$sort_by,
                        -command => $ord_bn_cb)
      ->grid(-column => 0, -row => 1, -sticky => "w");
$frame3->pack(-side => "right", -padx => 6);
$frame2->grid(-column => 0, -row => 1, -sticky => "w", -columnspan => 2);

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