Orac-alpha
view release on metacpan or search on metacpan
db/orac_Oracle.pm view on Meta::CPAN
);
$univ_form_win->{text}->windowCreate('end',-window=>$w);
$actual_entry[$index_win_cnt] = "$res[0]";
$ordered_entry[$index_win_cnt] = 0;
$w = $univ_form_win->{text}->Checkbutton(
-cursor=>'hand2',
-variable=>\$ordered_entry[$index_win_cnt],
-relief=>'flat'
);
$univ_form_win->{text}->windowCreate('end',-window=>$w);
$univ_form_win->{text}->insert('end', "\n");
$index_win_cnt++;
}
$index_win_cnt--;
$sth->finish;
$univ_form_win->{text}->configure( -state=>'disabled' );
$univ_form_win->{text}->pack( -expand =>1,
-fill=>'both'
);
my $bb;
my $balloon;
$self->create_balloon_bars(\$bb, \$balloon, \$univ_form_win );
if ($screen_type eq 'index'){
$help_txt = $main::lg{build_index};
} else {
$help_txt = $main::lg{sel_info};
}
my $image;
$self->get_img( \$univ_form_win, \$image, 'forward' );
my $forward_b = $bb->Button( -image=>$image,
-command=>sub{
$univ_form_win->Busy(-recurse=>1);
$self->selector( \$univ_form_win,
\$screen_type,,
\$screen_title,
\$index_win_cnt,
\@actual_entry,
\$owner,
\$object,
\@ordered_entry,
\@sql_entry,
);
$univ_form_win->Unbusy;
}
)->pack (-side=>'left',
-anchor=>'w');
$balloon->attach($forward_b, -msg => $help_txt );
$self->window_exit_button( \$bb, \$univ_form_win, 1, \$balloon, );
main::iconize( $univ_form_win );
if ($need_focus)
{
$$focus_r->focusForce;
}
}
=head2 selector
User may wish to narrow search for info with universal form, down to a
particular set of rows, and order these rows. This function helps
univ_form() and allows them to do that.
=cut
sub selector {
my $self = shift;
# User may wish to narrow search for info, down to
# a particular set of rows, and order these rows.
# This function allows them to do that.
my( $win_ref,
$screen_type_r,
$screen_title_r,
$index_cnt_r,
$entries_r,
$owner_r,
$object_r,
$ordered_entry_r,
$sql_entry_r,
) = @_;
my @actual_entries = @$entries_r;
my @ordered_entry = @$ordered_entry_r;
my @sql_entry = @$sql_entry_r;
# Start building up the select string
my $l_sel_str = ' select ';
if ($$screen_type_r eq 'index'){
$self->build_ord( $win_ref,
$screen_type_r,
$index_cnt_r,
$ordered_entry_r,
\$l_sel_str,
$owner_r,
$object_r,
db/orac_Oracle.pm view on Meta::CPAN
=head2 errors_orac
Creates Viewer window, for selecting invalid database objects.
Once this is done, all the reported compilation errors on the
object are printed in the main screen.
=cut
sub errors_orac {
my $self = shift;
# Creates Error Viewer window
my $cm = $self->f_str('errors_orac','1');
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
$sth->execute;
my $detected = 0;
my @res;
my $window;
while (@res = $sth->fetchrow) {
$detected++;
if($detected == 1){
$window = $self->{Main_window}->Toplevel();
$window->title($main::lg{err_obj});
my $err_menu;
my $balloon;
$self->create_balloon_bars(\$err_menu, \$balloon, \$window, );
$self->window_exit_button(\$err_menu, \$window, 1, \$balloon, );
$self->double_click_message(\$window);
my $err_top = $window->Frame->pack(-side=>'top',
-padx=>5,
-expand=>'yes',
-fill=>'both'
);
$window->{text} =
$err_top->ScrlListbox(-width=>50,
-font=>$main::font{name},
-background=>$main::bc,
-foreground=>$main::fc
)->pack(-side=>'top',
-expand=>'yes',
-fill=>'both');
main::iconize( $window );
}
$window->{text}->insert('end', @res);
}
$sth->finish;
if($detected == 0){
$self->{Main_window}->Busy(-recurse=>1);
main::mes($self->{Main_window},$main::lg{no_rows_found});
$self->{Main_window}->Unbusy;
} else {
$window->{text}->pack();
$window->{text}->bind(
'<Double-1>',
sub{ $window->Busy(-recurse=>1);
$self->selected_error(
$window->{text}->get('active')
);
$window->Unbusy}
);
}
}
=head2 dbas_orac
Creates DBA Viewer window, for selecting various DBA_XXXX tables,
which can then be selected upon.
=cut
sub dbas_orac {
my $self = shift;
# Creates DBA Viewer window
my $cm = $self->f_str('dbas_orac','1');
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
$sth->execute;
my $detected = 0;
my @res;
my $window;
while (@res = $sth->fetchrow) {
$detected++;
if($detected == 1){
$window = $self->{Main_window}->Toplevel();
$window->title($main::lg{dba_views});
my $dba_menu;
my $balloon;
$self->create_balloon_bars(\$dba_menu, \$balloon, \$window, );
$self->window_exit_button(\$dba_menu, \$window, 1, \$balloon, );
$self->double_click_message(\$window);
my(@dba_lay) = qw/-side top -padx 5 -expand yes -fill both/;
my $dba_top = $window->Frame->pack(@dba_lay);
$window->{text} =
$dba_top->ScrlListbox(-width=>50,
-font=>$main::font{name},
-background=>$main::bc,
-foreground=>$main::fc
)->pack(-expand=>'yes',-fill=>'both');
main::iconize($window);
}
$window->{text}->insert('end', @res);
}
$sth->finish;
if($detected == 0){
$self->{Main_window}->Busy(-recurse=>1);
main::mes($self->{Main_window},$main::lg{no_rows_found});
$self->{Main_window}->Unbusy;
} else {
$window->{text}->pack();
$window->{text}->bind(
'<Double-1>',
sub{
$window->Busy(-recurse=>1);
$self->{Main_window}->Busy(-recurse=>1);
$self->univ_form( 'SYS',
$window->{text}->get('active'),
'form'
);
$self->{Main_window}->Unbusy;
$window->Unbusy;
}
);
}
}
=head2 addr_orac
Produces a list of all the PADDR addresses in the database, to
help a DBA examine what's running. Useful info for deciding
what to kill off in a locked up database.
=cut
sub addr_orac {
my $self = shift;
# Creates DBA Viewer window
my $cm = $self->f_str('addr_orac','1');
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
$sth->execute;
my $detected = 0;
my @res;
my $window;
while (@res = $sth->fetchrow) {
$detected++;
if($detected == 1){
$window = $self->{Main_window}->Toplevel();
$window->title($main::lg{spec_addrss});
my $addr_menu;
my $balloon;
$self->create_balloon_bars(\$addr_menu, \$balloon, \$window, );
$self->window_exit_button(\$addr_menu, \$window, 1, \$balloon, );
$self->see_sql_but(\$addr_menu, \$window, \$cm, 1, \$balloon, );
$self->double_click_message(\$window);
my(@adr_lay) = qw/-side top -padx 5 -expand yes -fill both/;
my $adr_top = $window->Frame->pack(@adr_lay);
$window->{text} =
$adr_top->ScrlListbox(-width=>20,
-font=>$main::font{name},
-background=>$main::bc,
-foreground=>$main::fc
)->pack(-expand=>'yes',-fill=>'both');
main::iconize($window);
}
$window->{text}->insert('end', @res);
}
$sth->finish;
if($detected == 0){
$self->{Main_window}->Busy(-recurse=>1);
main::mes($self->{Main_window},$main::lg{no_rows_found});
$self->{Main_window}->Unbusy;
} else {
$window->{text}->pack();
$window->{text}->bind(
'<Double-1>',
sub{
my $loc_addr = $window->{text}->get('active');
$self->f_clr( $main::v_clr );
$self->show_sql( 'sel_addr' , '1',
$main::lg{sel_addr} . ': ' . $loc_addr,
$loc_addr );
}
);
}
}
=head2 sids_orac
Produces a list of all the SIDs in the database, to
help a DBA examine what's running. Useful info for deciding
what to kill off in a locked up database.
=cut
sub sids_orac {
my $self = shift;
# Creates DBA Viewer window
my $cm = $self->f_str('sids_orac','1');
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
$sth->execute;
my $detected = 0;
my @res;
my $window;
while (@res = $sth->fetchrow) {
$detected++;
if($detected == 1){
$window = $self->{Main_window}->Toplevel();
$window->title($main::lg{spec_sids});
my $sid_menu;
my $balloon;
$self->create_balloon_bars(\$sid_menu, \$balloon, \$window, );
$self->window_exit_button(\$sid_menu, \$window, 1, \$balloon, );
$self->see_sql_but(\$sid_menu, \$window, \$cm, 1, \$balloon, );
$self->double_click_message(\$window);
my(@sid_lay) = qw/-side top -padx 5 -expand yes -fill both/;
my $sid_top = $window->Frame->pack(@sid_lay);
$window->{text} =
$sid_top->ScrlListbox(-width=>20,
-font=>$main::font{name},
-background=>$main::bc,
-foreground=>$main::fc
)->pack(-expand=>'yes',-fill=>'both');
main::iconize($window);
}
$window->{text}->insert('end', @res);
}
$sth->finish;
if($detected == 0){
$self->{Main_window}->Busy(-recurse=>1);
main::mes($self->{Main_window},$main::lg{no_rows_found});
$self->{Main_window}->Unbusy;
} else {
$window->{text}->pack();
$window->{text}->bind(
'<Double-1>',
sub { $window->Busy(-recurse=>1);
$self->f_clr( $main::v_clr );
# 5 jan 2000, Andre Seesink <Andre.Seesink@CreXX.nl>
# Now we get sid and username
my ($sid, $username) = split(' ',$window->{text}->get('active'));
$self->show_sql( 'sel_sid' , '1',
$main::lg{sel_sid} . ': ' . $sid,
$sid );
$window->Unbusy
}
);
}
}
=head2 gh_roll_name
Produces Rollback report.
=cut
sub gh_roll_name {
my $self = shift;
my $cm = $self->f_str('time','2');
my $sth = $self->{Database_conn}->prepare($cm) ||
die $self->{Database_conn}->errstr;
$sth->execute;
my($sample_time) = $sth->fetchrow;
$sth->finish;
$self->{Text_var}->insert('end', "$sample_time\n");
$self->show_sql( 'roll_orac','2',
$main::lg{roll_seg_stats}
);
$self->about_orac('txt/Oracle/rollback.1.txt');
}
=head2 gh_roll_stats
Produces Rollback Statistics report.
=cut
sub gh_roll_stats {
my $self = shift;
my $cm = $self->f_str('time','2');
my $sth = $self->{Database_conn}->prepare($cm) ||
die $self->{Database_conn}->errstr;
$sth->execute;
my($sample_time) = $sth->fetchrow;
$sth->finish;
$self->{Text_var}->insert('end', "$sample_time\n");
$self->show_sql( 'roll_orac','1',
$main::lg{roll_seg_stats}
);
$self->about_orac('txt/Oracle/rollback.2.txt');
}
=head2 gh_pool_frag
Produces reports trying to determine shared pool fragmentation, etc.
db/orac_Oracle.pm view on Meta::CPAN
Orac user opportunity to "Explain Plan". Alternatively, Orac user
can clear screen and input their own new SQL to "Explain".
=cut
sub explain_plan {
my $self = shift;
# First of all, check if we have the correct PLAN_TABLE
# on board?
my $explain_ok = 0;
if ($self->check_exp_plan() == 0){
main::mes($self->{Main_window},$main::lg{use_utlxplan});
} else {
$explain_ok = 1;
}
my $window;
$window = $self->{Main_window}->Toplevel();
$window->title($main::lg{explain_plan});
my $dmb;
my $balloon;
$self->create_balloon_bars(\$dmb, \$balloon, \$window );
# Add buttons. Add a holder for the actual explain plan
# button so we can enable/disable it later
if($explain_ok){
my $img;
$self->get_img( \$window, \$img, 'explain' );
$expl_butt = $dmb->Button(-image=>$img,
-command=>sub{ $self->explain_it(\$window) }
)->pack(side=>'left');
$balloon->attach($expl_butt, -msg => $main::lg{explain} );
$self->get_img( \$window, \$img, 'eraser' );
my $clr_b = $dmb->Button( -image=>$img,
-command=>sub{
$window->Busy(-recurse=>1);
$w_explain[2]->delete('1.0','end');
$w_holders[0] = $main::v_sys;
$w_holders[1] = $main::lg{explain_help};
$expl_butt->configure(-state=>'normal');
$window->Unbusy;
}
)->pack(side=>'left');
$balloon->attach($clr_b, -msg => $main::lg{clear} );
}
$self->window_exit_button(\$dmb, \$window, 1, \$balloon, );
# Set counter up
my $i;
# Produce input/update screen. First, get the SQL select
# array filled, so we can work out the field titles
my $cm = $self->f_str('explain_plan','2');
my $sth;
$sql_browse_arr = $self->do_query_fetch_all( $cm, \$sth );
@w_titles = @{$sth->{NAME}};
# Work out the length of the Titles fields
my $num_cols = @w_titles;
my $l_label_width = 5;
my $l_entry_width = 55;
my $l_entry_height = 13;
for($i=0;$i<$num_cols;$i++){
if( (length($w_titles[$i])) > $l_label_width){
$l_label_width = length($w_titles[$i]);
}
}
# Now work out screen sizings
my(@exp_lay) = qw/-side top -padx 5 -expand yes -fill both/;
my $top_slice = $window->Frame->pack(@exp_lay);
for($i=0;$i<$num_cols;$i++){
# 0 user
# 1 address
# 2 SQL
$w_holders[$i] = '';
$w_explain[$i] = $top_slice->Entry(
-textvariable=>\$w_titles[$i],
-width=>$l_label_width
);
Tk::grid( $w_explain[$i],
-row=>$i,
-column=>0,
-sticky=>'ne',
);
if ($i == 2){
$w_explain[$i] =
$top_slice->Scrolled(
'Text',
db/orac_Oracle.pm view on Meta::CPAN
-foreground=>$main::fc
);
$self->{Text_var}->windowCreate('end',-window=>$scroll_label);
$self->{Text_var}->insert('end', "\n");
$self->{Text_var}->windowCreate('end',-window=>$scroll_box);
$self->{Text_var}->insert('end', "\n");
}
# Wait User first
$l_username = $res[0];
$l_osuser = $res[1];
$l_serial = $res[2];
$l_sid = $res[3];
$l_pid = $res[4];
$scrllist_str = "$l_wait_title:$l_username," .
"$l_os_title:$l_osuser," .
"$l_ser_title:$l_serial," .
"$l_sid_title:$l_sid," .
"$l_pid_title:$l_pid";
$scroll_box->insert('end', $scrllist_str);
# Hold User
$l_username = $res[6];
$l_osuser = $res[7];
$l_serial = $res[8];
$l_sid = $res[9];
$l_pid = $res[10];
$scrllist_str = "$l_hold_title:$l_username," .
"$l_os_title:$l_osuser," .
"$l_ser_title:$l_serial," .
"$l_sid_title:$l_sid," .
"$l_pid_title:$l_pid";
$scroll_box->insert('end', $scrllist_str);
}
$sth->finish;
if ($l_counter == 1){
$scroll_box->bind(
'<Double-1>',
sub{ $self->{Main_window}->Busy(-recurse=>1);
my @first_string = split(',', $scroll_box->get('active') );
my @v_osuser = split('\:', $first_string[1]);
my @v_username = split('\:', $first_string[0]);
my @v_sid = split('\:', $first_string[2]);
$self->who_what( 1,
$v_osuser[1],
$v_username[1],
$v_sid[1]
);
$self->{Main_window}->Unbusy
}
);
$self->{Text_var}->insert('end', "\n");
}
# And finally, thank goodness, the actual report.
$self->show_sql( 'wait_hold' , '1',
$main::lg{who_hold} );
}
=head2 mts_mem
Report for finding MTS statistics, and providing secondary button
to reveal further stats.
=cut
sub mts_mem
{
my $self = shift;
# Report for finding MTS statistics,
# and providing secondary button to reveal further stats
my $cm = $self->f_str( 'sess_curr_max_mem' , '1' );
my $l_counter = 0;
my $who_what_str;
my $l_stat;
my $l_stat_title;
my $scroll_label;
my $scroll_box;
my @res;
my @title_values;
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
$sth->execute;
while ( @res = $sth->fetchrow ) {
if ($l_counter == 0){
my $i;
for ($i = 0;$i < $sth->{NUM_OF_FIELDS};$i++){
$title_values[$i] = $sth->{NAME}->[$i];
}
$l_stat_title = $title_values[0];
$l_counter = 1;
$scroll_label =
$self->{Text_var}->Label(
-cursor=>'hand2',
-text=>"$main::lg{doub_click}",
-relief=>'raised'
);
$scroll_box =
$self->{Text_var}->ScrlListbox(-width=>40,
-cursor=>'hand2',
-height=>3,
-background=>$main::ec,
-foreground=>$main::fc
);
$self->{Text_var}->windowCreate('end',-window=>$scroll_label);
$self->{Text_var}->insert('end', "\n");
$self->{Text_var}->windowCreate('end',-window=>$scroll_box);
$self->{Text_var}->insert('end', "\n");
}
$l_stat = $res[0];
$who_what_str = "${l_stat_title}:$l_stat";
$scroll_box->insert('end', $who_what_str);
}
$sth->finish;
if ($l_counter == 1){
$scroll_box->bind(
'<Double-1>',
sub{ $self->{Main_window}->Busy(-recurse=>1);
my @stat_str = split('\:', $scroll_box->get('active') );
$self->who_what( 2,
$stat_str[1],
"${l_stat_title}:$stat_str[1]",
);
$self->{Main_window}->Unbusy
}
);
$self->{Text_var}->insert('end', "\n");
}
$self->show_sql( 'sess_curr_max_mem' , '1',
$main::lg{mts_mem} );
}
=head2 do_a_generic
On the final level of an HList, does the actual work required.
Takes the final PL/SQL function, runs it, and then splatts out the
results into a DialogBox for the User to peruse.
=cut
sub do_a_generic {
my $self = shift;
# On the final level of an HList, does the actual work
# required.
my ($l_mw, $l_gen_sep, $l_hlst, $input) = @_;
$l_mw->Busy(-recurse=>1);
my $owner;
my $generic;
my $dum;
($owner, $generic, $dum) = split("\\$l_gen_sep", $input);
my $window = $self->{Main_window}->Toplevel();
$window->bind('<Destroy>' => sub {
$window = undef;
}
);
# We may be using pretty :-) icons instead of text. If so,
# we gotta give help to let people know what the icons are.
my $menu_bar;
my $balloon;
my %b_images;
$self->create_balloon_bars(\$menu_bar, \$balloon, \$window );
if ( ($l_hlst eq 'Tables') ||
($l_hlst eq 'Indexes') ||
($l_hlst eq 'Views') )
{
foreach my $bit ( 'form',
'freespace',
'index',
'sizeindex',
'constraint',
db/orac_Oracle.pm view on Meta::CPAN
$text_lines = $obj->create ;
}
else
{
my $obj = DDL::Oracle->new(
type => $l_hlst_to_type{ $l_hlst },
list => [
[
$owner,
$generic || $owner,
]
],
);
if (
$l_hlst eq 'Tab_FreeSpace'
or $l_hlst eq 'Index_FreeSpace'
)
{
$text_lines = $obj->show_space ;
}
else
{
$text_lines = $obj->create ;
}
}
# Finally, pump out the monkey
#here
$window->{text}->insert('end', $text_lines);
# $self->{Text_var}->delete('1.0', 'end');
# $self->{Text_var}->insert('end', "$text_lines\n");
$self->see_sql_but(\$menu_bar, \$window, \$cm, 1, \$balloon, );
$b = $menu_bar->Button(-image=>$b_images{lines},
-command=> sub{
$window->Busy(-recurse=>1);
my @lines_of_txt = split(/^/, $text_lines);
my $line_counter = 1;
my $final_txt = '';
foreach my $line (@lines_of_txt)
{
$final_txt =
$final_txt .
sprintf( "%5d: %s",
$line_counter,
$lines_of_txt[($line_counter - 1)]
);
$line_counter++;
}
$self->see_sql($window,$final_txt,$label_text);
$window->Unbusy;
}
)->pack(-side=>'left');
$balloon->attach($b, -msg => $main::lg{lines} );
if ( ($l_hlst eq 'Tables') || ($l_hlst eq 'Indexes') ){
if ($l_hlst eq 'Tables') {
my $b = $menu_bar->Button(-image=>$b_images{form},
-command=> sub{
$window->Busy(-recurse=>1);
$self->univ_form($owner,
$generic,
'form');
$window->Unbusy
}
)->pack(-side=>'left');
$balloon->attach($b, -msg => $main::lg{form});
$b = $menu_bar->Button( -image=>$b_images{sizeindex},
-command=> sub {
$window->Busy(-recurse=>1);
$self->univ_form($owner,
$generic,
'index'
);
$window->Unbusy
}
)->pack(-side=>'left');
$balloon->attach($b, -msg => $main::lg{sizeindex});
}
my @tablist;
my @tablist_2;
if ($l_hlst eq 'Tables') {
@tablist = ('Tab_Indexes',
'Tab_FreeSpace',
'Tab_Constraints',
'Triggers',
'Comments');
@tablist_2 = ('index',
'freespace',
'constraint',
'trig',
'comment');
}
elsif ($l_hlst eq 'Indexes') {
@tablist = ('Index_FreeSpace');
@tablist_2 = ('freespace');
}
my $i = 0;
foreach ( @tablist ) {
my $this_txt = $_;
$b = $menu_bar->Button( -image=>$b_images{$tablist_2[$i]},
-text=>$tablist_2[$i],
-command=> sub {
$self->do_a_generic($window, '.', $this_txt, $input);
},
)->pack(-side=>'left');
$balloon->attach($b, -msg => $main::lg{$tablist_2[$i]});
$i++;
}
} elsif ($l_hlst eq 'Views'){
my $b = $menu_bar->Button(
-image=>$b_images{form},
-command=>sub{ $window->Busy(-recurse=>1);
$self->univ_form( $owner,
$generic,
'form'
);
$window->Unbusy }
)->pack(-side=>'left');
$balloon->attach($b, -msg => $main::lg{form});
}
$self->window_exit_button(\$menu_bar, \$window, 1, \$balloon, );
main::iconize( $window );
$l_mw->Unbusy;
}
=head2 tab_det_orac
Produces simple graphical representations of complex percentage style reports.
=cut
sub tab_det_orac {
my $self = shift;
# Produces simple graphical representations of complex
# percentage style reports.
my ( $title, $func, $file_number ) = @_;
my $d = $self->{Main_window}->Toplevel();
$d->title("$title: $main::v_db ($main::lg{blk_siz} $Block_Size)");
my $loc_menu;
my $balloon;
$self->create_balloon_bars(\$loc_menu, \$balloon, \$d, );
$self->window_exit_button(\$loc_menu, \$d, 1, \$balloon, );
my $cf = $d->Frame;
$cf->pack(-expand=>'1',-fill=>'both');
$d->{text} = $cf->Scrolled( 'Canvas',
-relief=>'sunken',
-bd=>2,
-width=>500,
-height=>280,
-background=>$main::bc
);
$keep_tablespace = 'XXXXXXXXXXXXXXXXX';
my $cm = $self->f_str($func, $file_number, );
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
# 3 jan 2000, Andre Seesink <Andre.Seesink@CreXX.nl>
# commented out, because we do not need this anymore
# the new tab_det_orac.1.sql does not need the blocksize anymore
#
# if($func eq 'tab_det_orac'){
# my $i;
# for ($i = 1;$i <= 6;$i++){
# $sth->bind_param($i,$Block_Size);
# }
# }
$sth->execute;
my $i = 1;
my $Grand_Total = 0.00;
my $Grand_Used_Mg = 0.00;
db/orac_Oracle.pm view on Meta::CPAN
which can then be selected upon.
=cut
sub dev_tables {
my $self = shift;
my ( $obj_type ) = @_;
# Creates Tables Viewer window
my $cm = $self->f_str('dev_tables',$obj_type);
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
$sth->execute;
my $detected = 0;
if ($obj_type =~ /^PACKAGE_BODY$/){
$obj_type = 'PACKAGE BODY';
}
my @res;
my $window;
my $schema = 0;
my $prompt = 0;
my $resize = 0;
my $action = 'create';
my $text ;
my $current_index ;
my $blue_tag ;
my $purple_tag ;
my $red_tag ;
my $green_tag ;
my $eraser ;
my $b ;
while (@res = $sth->fetchrow) {
$detected++;
if($detected == 1){
$window = $self->{Main_window}->Toplevel();
$window->title($obj_type . " DDL");
my $dev_menu;
my $balloon;
$self->create_balloon_bars(\$dev_menu, \$balloon, \$window, );
$self->window_exit_button(\$dev_menu, \$window, 1, \$balloon, );
$eraser = $window->Photo(-file=>"$FindBin::RealBin/img/eraser.gif");
$b = $dev_menu->Button(-image=>$eraser,
-command=>sub{
$window->Busy(-recurse=>1);
$self->{Main_window}->Busy(-recurse=>1);
$text->delete('1.0','end');
$self->{Main_window}->Unbusy;
$window->Unbusy;
}
)->pack(side=>'right');
$balloon->attach($b, -msg => $main::lg{clear});
my $dev_2_menu;
my $balloon2;
$self->create_balloon_bars(\$dev_2_menu, \$balloon2, \$window, );
$self->double_click_message(\$window);
my $label1 = $dev_menu->Label(relief=>'ridge'
)->pack (-side=>'left',
-anchor=>'w');
$label1->Radiobutton(variable=>\$prompt,
text=>"Prompt Off",
value=>0
)->pack (-side=>'left',
-anchor=>'w');
$label1->Radiobutton(variable=>\$prompt,
text=>"On",
value=>1
)->pack (-side=>'left',
-anchor=>'w');
my $label2 = $dev_menu->Label(relief=>'ridge'
)->pack (-side=>'left',
-anchor=>'w');
$label2->Radiobutton(variable=>\$schema,
text=>"Schema Off",
value=>0
)->pack (-side=>'left',
-anchor=>'w');
$label2->Radiobutton(variable=>\$schema,
text=>"On",
value=>1
)->pack (-side=>'left',
-anchor=>'w');
my $resize_state = 'disabled';
if (($obj_type =~ /^TABLE$/) || ($obj_type =~ /^INDEX$/)) {
$resize_state = 'normal';
}
my $label3 = $dev_menu->Label(relief=>'ridge'
)->pack (-side=>'left',
-anchor=>'w');
$label3->Radiobutton(variable=>\$resize,
text=>"Extent Resize Off",
value=>0,
state=>$resize_state
)->pack (-side=>'left',
-anchor=>'w');
db/orac_Oracle.pm view on Meta::CPAN
text=>"Compile",
value=>'compile',
state=>$compile_state
)->pack (-side=>'left',
-anchor=>'w');
my $dev_top = $window->Frame( -relief => 'groove',
)->pack(-fill=>'both',
-expand => 1,
-padx => 5,
-side => 'top'
);
$window->{text} =
$dev_top->ScrlListbox(-width=>20,
-height => 18,
-font=>$main::font{name},
-background=>$main::bc,
-foreground=>$main::fc
)->pack(-side=>'left',
-expand=>'yes',-fill=>'both');
$text = $dev_top->Scrolled( "Text",
-relief => 'groove',
-width => 40,
-height => 18,
-cursor=>undef,
-foreground=>'black',
-background=>'white',
-font=>$main::font{name},
-wrap => "none",
-takefocus => 0,
-setgrid => 1
)->pack(-side=>'left',
-fill=>'both',
-expand=>'both'
);
$purple_tag = $text->tagConfigure("purple", -foreground =>"purple");
$blue_tag = $text->tagConfigure("blue", -foreground =>"blue");
$red_tag = $text->tagConfigure("red", -foreground =>"red");
$green_tag = $text->tagConfigure("green", -foreground =>"green");
my $adjuster1 = $dev_top->Adjuster();
$adjuster1->packAfter( $window->{text},
-side => 'left',
);
main::iconize($window);
}
$window->{text}->insert('end', @res);
}
$sth->finish;
if($detected == 0){
$self->{Main_window}->Busy(-recurse=>1);
main::mes($self->{Main_window},$main::lg{no_rows_found});
$self->{Main_window}->Unbusy;
} else {
$window->{text}->selectionSet(0);
$window->{text}->pack();
$window->{text}->bind(
'<Double-1>',
sub{
$window->Busy(-recurse=>1);
$self->{Main_window}->Busy(-recurse=>1);
DDL::Oracle->configure(
dbh => $self->{Database_conn},
resize => $resize,
schema => $schema,
prompt => $prompt,
heading => 0,
view => $view,
blksize => $Block_Size,
version => $Oracle_Version
);
if ($obj_type =~ /^TABLE$/){
$obj_type = 'TABLE FAMILY';
}
my $obj = DDL::Oracle->new(
type => $obj_type,
list => [
[
$main::v_sys,
$window->{text}->get('active'),
]
]
);
my $sql;
if ( $action eq "drop" ){
$sql = $obj->drop;
}
elsif ( $action eq "create" ){
$sql = $obj->create;
}
elsif ( $action eq "resize" ){
$sql = $obj->resize;
}
elsif ( $action eq "compile" ){
$sql = $obj->compile;
}
# What is the current mark?
$current_index = $text->index('current');
$text->insert('end', $sql . "\n\n");
$self->search_text(\$text, $current_index);
$text->see( q{end linestart});
$self->{Main_window}->Unbusy;
$window->Unbusy;
}
);
}
}
=head2 dev_jpeg_tunen
Creates various tuning pies and inserts them into a pop-up screen.
=cut
sub dev_jpeg_tunen {
my $self = shift;
# Creates Tables Viewer window
my $cm = $self->f_str('tune_health', 1);
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
$sth->execute;
my @res;
my $window;
my $dbh;
my $rsth;
my $csth;
my $ratio;
my $anti_ratio;
my $real_ratio;
while (@res = $sth->fetchrow) {
$dbh = DBI->connect('dbi:Chart:');
$dbh->do('CREATE TABLE pie (label CHAR(30), ratio FLOAT)');
$csth = $dbh->prepare('INSERT INTO pie VALUES(?, ?)');
$real_ratio = $res[2];
$ratio = $real_ratio + 0.05;
$real_ratio = sprintf("%.2f", $real_ratio);
$ratio = sprintf("%.2f", $ratio);
$anti_ratio = 100.0 - $res[2];
$anti_ratio = sprintf("%.2f", $anti_ratio);
$csth->execute("", $ratio);
$csth->execute("", $anti_ratio);
$csth->finish;
$rsth = $dbh->prepare(
'SELECT PIECHART FROM pie ' .
'WHERE WIDTH=150 AND HEIGHT=150 ' .
'AND TITLE = \'' . $res[0] . ' ' . $real_ratio . '%\' ' .
'AND FORMAT=\'JPEG\' ' .
'AND 3-D=1 ' .
'AND SHOWVALUES=1 ' .
'AND COLOR=(purple, pink)');
# white, lgray, gray, dgray, black,
db/orac_Oracle.pm view on Meta::CPAN
$y_axis = "Invalid Object Count";
} elsif (($graph_type =~ /^INVOBJCNT$/)) {
$title_element = "Invalid User Objects";
$x_axis = "Invalid Object Type";
$y_axis = "Invalid Object Count";
} elsif (($graph_type =~ /^DBATABSPACE$/)) {
$title_element = "TableSpace Allocations";
$x_axis = "TableSpace";
$y_axis = "Space Allocations (MB)";
} elsif (($graph_type =~ /^TABSPACE$/)) {
$title_element = "Free TableSpace";
$x_axis = "TableSpace";
$y_axis = "Free Space (MB)";
} else {
$title_element = $graph_type;
$x_axis = "X-Axis";
$y_axis = "Y-Axis";
}
$window->title("Orac " . $title_element . " Chart");
my $dev_menu;
my $balloon;
$self->create_balloon_bars(\$dev_menu, \$balloon, \$window, );
$self->window_exit_button(\$dev_menu, \$window, 1, \$balloon, );
my(@dev_lay) = qw/-side top -padx 5 -expand yes -fill both/;
my $dev_top = $window->Frame->pack(@dev_lay);
$window->{canv} =
$dev_top->Scrolled( 'Canvas',
-relief=>'sunken',
-bd=>2,
-width=>730,
-height=>330,
-background=>$main::bc
);
main::iconize($window);
}
if (($graph_type =~ /^DBATABSPACE$/)) {
if ($flip_switch){
$csth->execute($res[1], $hold1, $hold1 - $res[2], $res[2]);
} else {
$hold1 = $res[2];
}
} else {
$csth->execute($res[0], $res[1]);
}
if ($flip_switch){
$flip_switch = 0;
} else {
$flip_switch = 1;
}
}
$sth->finish;
if($detected == 0){
$self->{Main_window}->Busy(-recurse=>1);
main::mes($self->{Main_window},$main::lg{no_rows_found});
$self->{Main_window}->Unbusy;
} else {
$csth->finish;
$rsth = $dbh->prepare(
'SELECT BARCHART FROM bars ' .
'WHERE WIDTH=700 AND HEIGHT=300 ' .
'AND X-AXIS=\'' . $x_axis .
'\' AND Y-AXIS=\'' . $y_axis . '\' AND ' .
'X-ORIENT=\'VERTICAL\' AND ' .
'FORMAT=\'JPEG\' AND ' .
'TITLE = \'' . $title_element .
'\' AND 3-D=' . $three_d . ' ' .
'AND SHOWVALUES=' . $show_values . ' AND ' .
'COLOR=(lred, lgreen, lorange, marine, pink, yellow, lpurple)');
# white, lgray, gray, dgray, black,
# lblue, blue, dblue, gold, lyellow, yellow,
# dyellow, lgreen, green. dgreen,
# lred, red, dred, lpurple, purple,
# dpurple, lorange, orange, pink,
# dpink, marine, cyan, lbrown, dbrown.
my $buf;
$rsth->execute;
$rsth->bind_col(1, \$buf);
$rsth->fetch;
open OUTF, ">$main::orac_home/dev_jpeg.jpeg";
binmode OUTF;
print OUTF $buf;
close OUTF;
$rsth->finish;
$dbh->do('DROP CHART bars');
$dbh->disconnect;
my $img =
$window->{canv}->Photo( -file => "$main::orac_home/dev_jpeg.jpeg",
-format => 'jpeg');
$window->{canv}->create( 'image',5,5,
'-anchor' => 'nw',
'-image' => $img );
$window->{canv}->pack(-expand=>'yes',-fill=>'both');
}
}
=head2 dev_tablespace
Creates DBA Viewer window, for selecting various tablespace,
which can then be selected upon.
=cut
sub dev_tablespace {
my $self = shift;
my ( $obj_type ) = @_;
# Creates Tablespace Viewer window
my $cm = $self->f_str('dev_tablespace',$obj_type);
my $sth = $self->{Database_conn}->prepare( $cm ) ||
db/orac_Oracle.pm view on Meta::CPAN
while (@res = $sth->fetchrow) {
$detected++;
if($detected == 1){
$window = $self->{Main_window}->Toplevel();
$window->title($obj_type . " Drilldown");
my $dev_menu;
my $balloon;
$self->create_balloon_bars(\$dev_menu, \$balloon, \$window, );
$self->window_exit_button(\$dev_menu, \$window, 1, \$balloon, );
$self->double_click_message(\$window);
$dev_menu->Radiobutton(variable=>\$action,
text=>"Total Space",
value=>'totalspace'
)->pack (-side=>'left',
-anchor=>'w');
$dev_menu->Radiobutton(variable=>\$action,
text=>"Tables Breakdown",
value=>'tables'
)->pack (-side=>'left',
-anchor=>'w');
$dev_menu->Radiobutton(variable=>\$action,
text=>"Index Breakdown",
value=>'indexes'
)->pack (-side=>'left',
-anchor=>'w');
my(@dev_lay) = qw/-side top -padx 5 -expand yes -fill both/;
my $dev_top = $window->Frame->pack(@dev_lay);
$window->{canv} =
$dev_top->Scrolled( 'Canvas',
-relief=>'sunken',
-bd=>2,
-width=>730,
-height=>330,
-background=>$main::bc
);
$window->{text} =
$dev_top->ScrlListbox(-width=>50,
-font=>$main::font{name},
-background=>$main::bc,
-foreground=>$main::fc
)->pack(-expand=>'yes',-fill=>'both');
main::iconize($window);
}
$window->{text}->insert('end', @res);
}
$sth->finish;
if($detected == 0){
$self->{Main_window}->Busy(-recurse=>1);
main::mes($self->{Main_window},$main::lg{no_rows_found});
$self->{Main_window}->Unbusy;
} else {
$window->{text}->pack();
$window->{text}->bind(
'<Double-1>',
sub{
$window->Busy(-recurse=>1);
$self->{Main_window}->Busy(-recurse=>1);
# Function
if ( $action eq "totalspace" ){
print "totalspace\n";
}
elsif ( $action eq "tables" ){
print "tables\n";
}
elsif ( $action eq "indexes" ){
print "indexes\n";
}
$self->{Main_window}->Unbusy;
$window->Unbusy;
}
);
}
}
sub search_text {
my ($self, $t, $curr) = @_;
my @blue_bits = ( 'ADD_MONTHS', 'ALTER', 'AND', 'AS', 'ASCII',
'AVG', 'BEGIN', 'BIT_LENGTH', 'BLOCK', 'BODY',
'CASE', 'CAST', 'CEIL', 'CHAR_LENGTH', 'CHR',
'CLOSE', 'COMMIT', 'CONCAT', 'CONSTRAINT', 'CONVERT',
'COUNT', 'CREATE', 'CURDATE','CURRENT_DATE','CURRENT_TIME',
'CURRENT_TIMESTAMP', 'CURSOR', 'CURTIME', 'DATABASE',
'DAYOFMONTH',
'DAYOFWEEK', 'DAYOFYEAR', 'DECLARATION', 'DECLARE',
'DECODE', 'DELETE', 'END', 'EXCEPTION', 'EXCEPTION_INIT',
'EXIT',
'EXPLAIN', 'EXTRACT', 'FETCH', 'FLOOR', 'FOR',
'FOUND', 'FUNCTION', 'GOTO', 'GRANT', 'GREATEST',
'HINTS', 'HOUR', 'IF', 'IFNULL', 'INDEX',
'INDICATOR', 'INITCAP', 'INSERT', 'INSTR', 'INSTRB',
'INTERVAL', 'INTO', 'IS', 'ISOPEN', 'JAVA',
'LABEL', 'LAST_DAY', 'LCASE', 'LEAST', 'LENGTH',
'LENGTHB', 'LEVEL', 'LOCATE', 'LOCK', 'LOOP',
'LOWER', 'LPAD', 'LTRIM', 'MAX', 'MIN',
'MINUTE', 'MOD', 'MONTH', 'MONTHS_BETWEEN', 'NEXT_DAY',
'NOTFOUND', 'NOW', 'NULL', 'NVL', 'OCTET_LENGTH',
'OPEN', 'OR', 'PACKAGE', 'PLAN', 'POSITION',
'PRAGMA', 'PROCEDURE', 'QUARTER', 'RAISE', 'RECORD',
'REPLACE', 'REVOKE', 'ROLLBACK', 'ROUND', 'ROWCOUNT',
'ROWNUM', 'RPAD', 'SAVEPOINT', 'SCHEMA', 'SECOND',
'SELECT', 'SEQUENCE', 'SESSION', 'SET', 'SQL',
'SQLCODE', 'SQLERRM','SQLTERMINATOR','STDDEV','STRUCTURE',
'SUBSTR', 'SUBSTRB', 'SUM', 'SYNONYM', 'SYSDATE',
'TABLE', 'TERMINATOR', 'TIMESTAMPADD', 'TIMESTAMPDIFF',
'TO_CHAR',
'TO_DATE', 'TO_NUMBER', 'TRANSACTION', 'TRANSLATE',
'TRIGGER',
'TRIM', 'TRUNC', 'TYPE', 'UCASE', 'UPDATE',
'UPPER', 'USER', 'VARIABLE', 'VARIANCE', 'VIEW',
'WEEK', 'WHILE', 'YEAR',
);
#for (@blue_bits){
# $self->search_text_2(1, $_, "blue", $t, $curr);
#}
my @red_bits = ('[%(),;]'
);
for (@red_bits){
$self->search_text_2(0, $_, "red", $t, $curr);
}
my @purple_bits = ('DATE','VARCHAR2','NUMBER','BFILE','CLOB',
'LONG','CHAR'
);
#for (@purple_bits){
db/orac_Oracle.pm view on Meta::CPAN
);
my $text2 = $frame1->Scrolled( "Text",
-relief => 'groove',
-width => 50,
-height => 10,
-cursor=>undef,
-foreground=>$main::fc,
-background=>$main::bc,
-font=>$main::font{name},
-wrap => "none",
-takefocus => 0,
-setgrid => 1
)->pack(-side=>'left',
-fill=>'both',
-expand=>'both'
);
my $canvas_id;
$self->dev_jpeg_tabsp(\$canvas, \$canvas_id, 'DBATABSPACE');
$canvas->configure(-scrollregion=>[ $canvas->bbox("all") ]);
$canvas->pack(-expand=>'yes',-fill=>'both');
my $adjuster1 = $frame1->Adjuster();
$adjuster1->packAfter( $canvas,
-side => 'left',
);
$window->{text} =
$frame2->Scrolled('HList',
-drawbranch=> 1,
-separator=> $tabsp_sep,
-indent=> 50,
-selectmode=>'single',
-browsecmd=>sub{
$curr_tabdata = shift;
if ($curr_tabdata =~ /:/){
my ($tabspace, $datafile) =
split(/\:/, $curr_tabdata);
$main::conn_comm_flag = 1;
eval {
$canvas->delete($canvas_id);
};
$main::conn_comm_flag = 0;
$window->Busy(-recurse=>1);
$self->{Main_window}->Busy(-recurse=>1);
$self->dev_jpeg_tabsp(\$canvas,
\$canvas_id,
'EXTENTID',
$datafile
);
$canvas->configure(
-scrollregion=>[ $canvas->bbox("all") ]);
$canvas->pack(-expand=>'yes',-fill=>'both');
$self->{Main_window}->Unbusy;
$window->Unbusy;
}
},
-width=> 80,
-height=> 20,
-font=>$main::font{name},
-foreground=> $main::fc,
-background=> $main::bc,
-command=> sub {
$self->show_or_hide_tabsp( \$text2,
$_[0],
$window,
$window->{text},
);
},
)->pack(-fill=>'both',
-expand=>'both',
-side=>'top'
);
my $adjuster2 = $frame1->Adjuster();
$adjuster2->packAfter( $frame2,
-side => 'top'
);
$self->get_img( \$window, \$open_fold_bit, 'folder.open' );
$self->get_img( \$window, \$close_fold_bit, 'folder' );
$self->get_img( \$window, \$tabsp_bit, 'text' );
my $cm = $self->f_str( $tab_hlst ,'1');
print "prepare1: $cm\n" if ($main::debug > 0);
my $sth = $self->{Database_conn}->prepare( $cm )
or die $self->{Database_conn}->errstr;
$sth->execute;
my $bitmap = (tabsp_file_exist($self->{Database_type}, $tab_hlst, 2)
? $close_fold_bit
: $tabsp_bit);
my @res;
my $count = 0;
while (@res = $sth->fetchrow)
{
my $owner = $res[0];
if (!$count){
$curr_tabdata = $owner;
$count++;
}
$window->{text}->add( $owner,
-itemtype=>'imagetext',
-image=>$bitmap,
-text=>$owner
);
}
$sth->finish;
db/orac_Oracle.pm view on Meta::CPAN
$text->add( $gen_thing,
-itemtype => 'imagetext',
-image => $bitmap,
-text => $gen_thing
);
}
}
$sth->finish;
}
sub tabsp_file_exist
{
my ($type, $sub, $number) = @_;
# FindBin::RealBin patch below supplied by Bruce Albrecht,
# 9/9/99
my $file =
sprintf("$FindBin::RealBin/sql/%s/%s.%d.sql",$type,$sub,$number);
print "tabsp_file_exist: $file\n" if ($main::debug > 0);
return (-r $file);
}
sub do_a_tabsp {
my $self = shift;
# On the final level of an HList, does the actual work
# required.
my ($text2_ref, $l_mw, $l_tabsp_sep, $l_hlst, $input) = @_;
$l_mw->Busy(-recurse=>1);
my $owner;
my $generic;
my $dum;
($owner, $generic, $dum) = split("\\$l_tabsp_sep", $input);
# We may be using pretty :-) icons instead of text. If so,
# we gotta give help to let people know what the icons are.
my $cm;
#my $obj = DDL::Oracle->new(
# type => $l_hlst_to_type{ $l_hlst },
# list => [
# [
# $owner,
# $generic || $owner,
# ]
# ],
# );
#$text_lines = $obj->create ;
# Finally, pump out the monkey
$$text2_ref->insert('end', "$owner $generic");
$l_mw->Unbusy;
}
=head2 post_tabsp
This subroutine is called with the results from show_sql() to allow DB
modules to "post process" the output, if required, before it is analyzed
to be shown.
This is useful for turning numeric flags into words, and other such DB
dependent things.
This generic one does NOTHING!
=cut
sub post_tabsp
{
my $self = shift;
return;
}
sub dev_jpeg_tabsp {
my $self = shift;
my ( $canv_ref, $canv_id_ref, $graph_type, $param1 ) = @_;
# Creates Tables Viewer window
my $cm = $self->f_str('dev_jpeg',$graph_type);
my $sth = $self->{Database_conn}->prepare( $cm ) ||
die $self->{Database_conn}->errstr;
if ($graph_type =~ /^EXTENTID$/) {
$sth->bind_param(1,$param1);
}
$sth->execute;
my $detected = 0;
my @res;
my $window;
my $dbh;
my $rsth;
my $csth;
my $title_element;
my $x_axis;
my $y_axis;
my $show_values = 1;
my $three_d = 1;
my $chart_width = 700;
my $flip_switch = 0;
my $old_hold ;
my $hold1 = 0.0;
my $hold2 = 0.0;
my $color_string = 'COLOR=(lred,lgreen,lorange,marine,pink,yellow,lpurple)';
while (@res = $sth->fetchrow) {
$detected++;
if($detected == 1){
db/orac_Oracle.pm view on Meta::CPAN
$x_axis = "Object Type";
$y_axis = "Object Count";
} elsif (($graph_type =~ /^INVDBAOBJCNT$/)) {
$title_element = "All Invalid DBA Objects";
$x_axis = "Invalid Object Type";
$y_axis = "Invalid Object Count";
} elsif (($graph_type =~ /^ALLOBJCNT$/)) {
$title_element = "All Objects";
$x_axis = "Object Type";
$y_axis = "Object Count";
} elsif (($graph_type =~ /^INVALLOBJCNT$/)) {
$title_element = "All Invalid Objects";
$x_axis = "Invalid Object Type";
$y_axis = "Invalid Object Count";
} elsif (($graph_type =~ /^INVOBJCNT$/)) {
$title_element = "Invalid User Objects";
$x_axis = "Invalid Object Type";
$y_axis = "Invalid Object Count";
} elsif (($graph_type =~ /^DBATABSPACE$/)) {
$title_element = "TableSpace Allocations";
$x_axis = "TableSpace";
$y_axis = "Space Allocations (MB)";
} elsif (($graph_type =~ /^TABSPACE$/)) {
$title_element = "Free TableSpace";
$x_axis = "TableSpace";
$y_axis = "Free Space (MB)";
} else {
$title_element = $graph_type;
$x_axis = "X-Axis";
$y_axis = "Y-Axis";
}
}
if (($graph_type =~ /^DBATABSPACE$/)) {
if ($flip_switch){
$csth->execute($res[1], $hold1, $hold1 - $res[2], $res[2]);
} else {
$hold1 = $res[2];
}
} elsif ($graph_type =~ /^EXTENTID$/) {
if (length($res[1]) > 18){
$res[1] = substr($res[1],1,18) . "..";
}
$csth->execute($res[1], $res[2]);
$chart_width += 20;
} else {
$csth->execute($res[0], $res[1]);
}
if ($flip_switch){
$flip_switch = 0;
} else {
$flip_switch = 1;
}
}
$sth->finish;
if($detected == 0){
$self->{Main_window}->Busy(-recurse=>1);
main::mes($self->{Main_window},$main::lg{no_rows_found});
$self->{Main_window}->Unbusy;
} else {
$csth->finish;
if ($chart_width < 700){
$chart_width = 700;
}
$rsth = $dbh->prepare(
'SELECT BARCHART FROM bars ' .
'WHERE WIDTH=' . $chart_width . ' AND HEIGHT=300 ' .
'AND X-AXIS=\'' . $x_axis .
'\' AND Y-AXIS=\'' . $y_axis . '\' AND ' .
'X-ORIENT=\'VERTICAL\' AND ' .
'FORMAT=\'JPEG\' AND ' .
'TITLE = \'' . $title_element .
'\' AND 3-D=' . $three_d . ' ' .
'AND SHOWVALUES=' . $show_values . ' AND ' .
$color_string
);
# white, lgray, gray, dgray, black,
# lblue, blue, dblue, gold, lyellow, yellow,
# dyellow, lgreen, green. dgreen,
# lred, red, dred, lpurple, purple,
# dpurple, lorange, orange, pink,
# dpink, marine, cyan, lbrown, dbrown.
my $buf;
$rsth->execute;
$rsth->bind_col(1, \$buf);
$rsth->fetch;
open OUTF, ">$main::orac_home/dev_jpeg.jpeg";
binmode OUTF;
print OUTF $buf;
close OUTF;
$rsth->finish;
$dbh->do('DROP CHART bars');
$dbh->disconnect;
my $img =
$$canv_ref->Photo( -file => "$main::orac_home/dev_jpeg.jpeg",
-format => 'jpeg');
$$canv_id_ref = $$canv_ref->create( 'image',5,5,
'-anchor' => 'nw',
'-image' => $img );
$$canv_ref->pack(-expand=>'yes',-fill=>'both');
}
}
# ======== Oracle Tablespace Tuning Tool ===========
1;
( run in 1.564 second using v1.01-cache-2.11-cpan-39bf76dae61 )