Orac-alpha
18 results

 view release on metacpan or  search on metacpan

db/orac_Sybase.pm  view on Meta::CPAN 

	    while($another_row = $sth->fetchrow){
		$self->{Text_var}->insert('end', $another_row."\n");
	    }       
	} while($sth->{syb_more_results});
	$self->{Text_var}->insert('end', "\n\n");
    }
    $sth->finish;

    $cm = 'select name, user_name(uid) from sysobjects where type in ("P", "TR", "V") order by name';
    $sth = $self->{Database_conn}->prepare($cm) || die $self->{Database_conn}->errstr; 
    $sth->execute;
    my %procs;
    @row = ();
    while(@row = $sth->fetchrow){
	$procs{$row[0]} = $row[1];
    }
    $sth->finish;

    $main::conn_comm_flag = 999;
    for (keys %procs) {
	undef $main::store_msgs;
	$self->{Database_conn}->do("use $db");
	$sth = $self->{Database_conn}->prepare("exec sp__helptext \"$procs{$_}.$_\""); 
	$sth->execute;
	$main::store_msgs =~ s/^\s//g;
	$self->{Text_var}->insert('end', $main::store_msgs."\n");
	$self->{Text_var}->insert('end', "\n\n");
	$sth->finish;
    }
    undef $main::conn_comm_flag;
    undef $main::store_msgs;

  $self->see_plsql($self->f_str('rev_tbl','1'));
}


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;
   my $gen_sep;

   ($owner, $generic, $dum) = split("\\$l_gen_sep", $input);
   
   my $loc_g_hlst;
   my $cm = $self->f_str($l_hlst ,'99');

   if ($l_hlst eq 'Segments' || $l_hlst eq 'All Objects') {
       $self->f_clr( $main::v_clr );
       $self->{Database_conn}->do("use $owner");
       my $reportHeader = ($l_hlst eq 'Segments') ? "Segment Allocation" : "All Objects in $owner";
       $self->show_sql($l_hlst, '99', $reportHeader, $generic, $owner);
       $l_mw->Unbusy;
       return;
   } else {
       $cm = ($l_hlst eq 'Groups') ? sprintf($cm, $generic, $generic) : sprintf($cm, $generic);
   }

   my $second_sth = $self->{Database_conn}->prepare( $cm ) ||
                      die $self->{Database_conn}->errstr; 
   # Deal with SQL print returns through the global message handler
   $main::conn_comm_flag = 999;
   $second_sth->execute;
   $main::conn_comm_flag = 0;

   my $menu_bar;
   my $balloon;
   my %b_images;

   my $window = $self->{Main_window}->Toplevel();

   $window->bind('<Destroy>' => sub {
                                 $window = undef;
                                                    }
                                );
   $window->title ("$l_hlst $main::lg{sql_for} $owner.$generic");

   if ( ($l_hlst eq 'Tables') || 
       ($l_hlst eq 'System Tables') ||
       ($l_hlst eq 'Views') ||
       ($l_hlst eq 'Procedures') ||
       ($l_hlst eq 'Triggers'))
   {
      $self->create_balloon_bars(\$menu_bar, \$balloon, \$window );

      foreach my $bit ('sizeindex', 
		       'form', 
		       'freespace',
		       'index',
		       'constraint',
		       'trig',
		       'comment',
		       )
      {
         $b_images{$bit} = $window->Photo( 
            -file => "$FindBin::RealBin/img/${bit}.gif" );
      }
   }
   else
   {
      $self->create_button_bar(\$menu_bar, \$window );
   }
   
   $window->{text} = $window->Scrolled('Text',
				       -width=>95,
				       -height=>24,
				       -wrap=>'none',
				       -cursor=>undef,
				       -foreground=>$main::fc,
				       -background=>$main::bc
				       )->pack(-expand=>1,-fil=>'both');

   tie (*L_TEXT, 'Tk::Text', $window->{text});

   my $j = 0;
   my $full_list;
   my $i = 1;
   $main::store_msgs =~ s/^\s//g;
   $main::store_msgs =~ s/go//mig;
   print L_TEXT $main::store_msgs if ($l_hlst eq 'Triggers' ||
				      $l_hlst eq 'Procedures' ||
				      $l_hlst eq 'RelatedProcedures' ||
				      $l_hlst eq 'RelatedTriggers' ||
				      $l_hlst eq 'Views');
   undef($main::store_msgs);
   my $another_row;
   do {
       while($another_row = $second_sth->fetchrow){
	   next if ($another_row == 1);
           print L_TEXT $another_row, "\n";
       }       
   } while($second_sth->{syb_more_results});

   $second_sth->finish;
   my $b;

   if ($l_hlst eq 'Tables' || $l_hlst eq 'System Tables'){
       print L_TEXT "\n\n  ";
       my $i = 0;
       my @tab_options = ('index', 'constraint', 'trig', 'freespace', 'comment');
 
       foreach ($main::lg{indexs},$main::lg{constrnts},$main::lg{trggrs_dep}, $main::lg{procs_dep}, $main::lg{oi_grants}){
	   my $this_txt = $_;

	   $b = $menu_bar->Button(-image=>$b_images{$tab_options[$i]},
				  -text=>$this_txt,
				  -command=>sub {$self->do_a_generic($window, '.', $this_txt, $input);}
				  )->pack(-side=>'left');
	   $balloon->attach($b, -msg => $_);
	   
	   print L_TEXT " ";
	   $i++;
       }
       print L_TEXT "\n\n  ";
       
       $b = $menu_bar->Button(-image=>$b_images{form},
			      -command=>
			      sub{$window->Busy(-recurse=>1);
				  $self->univ_form($window,$owner,$generic,'form');
				  $window->Unbusy }
			      )->pack(-side=>'left');
       $balloon->attach($b, -msg => $main::lg{form});
       
       $i++;
       
       $b =  $menu_bar->Button(-image=>$b_images{sizeindex},
			       -command=> sub{$window->Busy(-recurse=>1);
					      $self->univ_form($window,$owner,$generic,'index');
					      $window->Unbusy }
			       )->pack(-side=>'left');
       
       $balloon->attach($b, -msg => $main::lg{build_index});
       print L_TEXT " ";
   } elsif($l_hlst eq 'Procedures' || $l_hlst eq 'Triggers') {
       $window->{ed_button} = $menu_bar->Button(-image=>$b_images{form},
			     -command=>sub{
				 $window->{text}->configure(-state=>'normal');
				 $window->{rc_button}->configure(-state=>'normal');
				 $window->{ed_button}->configure(-state=>'disabled');
			     }
			     )->pack(-side=>'left');
       $balloon->attach($window->{ed_button}, -msg => 'Edit');
       
       $window->{rc_button} =  $menu_bar->Button(-image=>$b_images{sizeindex},
			       -command=> sub{$window->Busy(-recurse=>1);
					      $window->{text}->configure(-state=>'disabled');
					      $window->{rc_button}->configure(-state=>'disabled');
					      $window->{ed_button}->configure(-state=>'normal');
					      $self->change_sql($window,$generic, $l_hlst);
					      $window->Unbusy },
			       -state=>'disabled'
			       )->pack(-side=>'left');
       
       $balloon->attach($window->{rc_button}, -msg => 'Recompile');
   } elsif ($l_hlst eq 'Views'){
      print L_TEXT "\n\n  ";
      $b = menu_bar->Button(-text=>$main::lg{form},
			    -command=>sub{$window->Busy(-recurse=>1); 
					  $self->univ_form($window,$owner,$generic,'form');
					  $window->Unbusy }
			    )->pack(-side=>'left');
      $balloon->attach($b, -msg => $main::lg{form});
  }
   
   print L_TEXT "\n\n";
   $self->window_exit_button(\$menu_bar, \$window );
   $window->{text}->configure(-state=>'disabled');
   main::iconize( $window );
   $l_mw->Unbusy;
}

sub change_sql {
    my $self = shift;
    
    my ($loc_d,$obj,$l_hlst) = @_;

    chop $l_hlst;
    my $sp_text = $loc_d->{text}->get("1.0", "end"); 
    my $drop_sql = qq{ drop $l_hlst $obj };
    $self->{Database_conn}->do($drop_sql);
    $self->{Database_conn}->do($sp_text);
    return;
}

sub explain_plan {
   my $self = shift;

   my $window = $self->{Main_window}->Toplevel();
   $window->title($main::lg{explain_plan});

   my(@exp_lay) = qw/-side top -padx 5 -expand no -fill both/;
   my $dmb = $window->Frame->pack(@exp_lay);
   my $orac_li = $window->Photo(-file=>'img/orac.gif');

   $dmb->Label(-image=>$orac_li,
	       -borderwidth=>2,
	       -relief=>'flat'
	       )->pack(-side=>'left',
		       -anchor=>'w');

   # Add buttons.  Add a holder for the actual explain plan
   # button so we can enable/disable it later

   my $expl_butt = $dmb->Button(-text=>$main::lg{explain},
				-command=>sub{ $self->explain_it();}
				)->pack(side=>'left');

   $dmb->Button(-text=>$main::lg{clear},
		-command=>sub{
                      $window->Busy(-recurse=>1);
                      $sql_txt->delete('1.0','end');
                      my $w_user_name = $main::v_sys;
                      $expl_butt->configure(-state=>'normal');
                      $window->Unbusy;
		  }
               )->pack(side=>'left');

   $dmb->Button(-text=>$main::lg{exit},
		-command=> sub{
                      $window->destroy();
                      $window->Busy(-recurse=>1);
 		      my $cm = $self->f_str('explain_plan','3');
		      $self->{Database_conn}->do($cm);
		      $cm = $self->f_str('explain_plan','4');
		      $self->{Database_conn}->do($cm);
                      $window->Unbusy;
		      undef $main::conn_comm_flag;
		  } 
               )->pack(-side=>'left');

   $dmb->Label(-text=>"     Use ",-borderwidth=>2,-relief=>'flat')->pack(-side=>'left',-anchor=>'w');

   # need to get a db list for dropdown
   my $sth;
   my $cm = "select db_name()";
   my @list = ();
   $sth = $self->{Database_conn}->prepare( $cm ) ||
             die $self->{Database_conn}->errstr; 
   $sth->execute;
   my $tmp = $sth->fetchrow;

   push @list, $tmp;
   $cm = $self->f_str('Tables' ,'1');
   $sth = $self->{Database_conn}->prepare( $cm ) || 
            die $self->{Database_conn}->errstr; 
   $sth->execute;
   my $row;
   while($row = $sth->fetchrow){
       push @list, $row unless ($row eq $tmp);
   }       
   $sth->finish;

   $dmb->Optionmenu(-options=> [@list],
		    -command=> sub{
		      $main::conn_comm_flag = 999;
		      my $cm = $self->f_str('explain_plan','3');
		      $self->{Database_conn}->do($cm);
		      $cm =  $self->f_str('explain_plan','4');
		      $self->{Database_conn}->do($cm);
		      $cm = "use ".shift;
		      $self->{Database_conn}->do($cm);
		      $cm = $self->f_str('explain_plan','1');
		      $self->{Database_conn}->do($cm);
		      $cm = $self->f_str('explain_plan','2');
		      $self->{Database_conn}->do($cm);},
		    -variable=> \$tmp
               )->pack(-side=>'left');

   @exp_lay = qw/-side top -padx 5 -expand yes -fill both/;
   my $top_slice = $window->Frame->pack(@exp_lay);

   my $sql_txt_width = 50;
   my $sql_txt_height = 15;
   $window->{text} = $top_slice->Scrolled('Text',
					   -wrap=>'none',
					   -cursor=>undef,
					   -height=>($sql_txt_height + 4),
					   -width=>($sql_txt_width + 10),
					   -foreground=>$main::fc,
					   -background=>$main::bc);
   # Set the holding variables

   my $w_user_name = '';
   my $w_orig_sql_string = '';

   $sql_txt = $window->{text}->Scrolled('Text',

db/orac_Sybase.pm  view on Meta::CPAN 

    Tk::grid($l7,-row=>6,-column=>0,-sticky=>'e');                                
    Tk::grid($ps_bd,-row=>6,-column=>1,-sticky=>'ew');        
    Tk::grid($l9,-row=>9,-column=>0,-sticky=>'e');                                
    Tk::grid($ps_cs,-row=>9,-column=>1,-sticky=>'ew');        
    Tk::grid($l10,-row=>10,-column=>0,-sticky=>'e');                                
    Tk::grid($ps_lang,-row=>10,-column=>1,-sticky=>'ew');        

    $d->gridRowconfigure(1,-weight=>1);
    my $button = $d->Show;
    $self->f_clr( $main::v_clr );
}

sub show_server_stat {
    my $self = shift;
    main::bz();

    # Get Server name
    my @data = ();
    my $cm = "exec sp_monitor";
    my $sth = $self->{Database_conn}->prepare($cm) || die $self->{Database_conn}->errstr; 
    $sth->execute;
    my @row = ();
    do {
	while(@row = $sth->fetchrow()) {
	    for (@row) {
		s/-.*//g;
		s/\(/\//g;
		s/\)//g;
		push @data, $_;
	    }
	}
    } while($sth->{syb_more_results});
    $sth->finish;

    my $d = $main::mw->DialogBox(-title => $main::lg{srv_prop},
				 -buttons => ["Dismiss"]);

    my $l1 = $d->Label(-text=> "Last Run:", justify=>"right");
    my $ps1 = $d->add("Entry",
		      -cursor=>undef,
		      -textvariable=>\$data[0],
		      -state=>'disabled',
		      -foreground=>$main::fc,
		      -background=>$main::ec)->pack();
    
    my $l2 = $d->Label(-text=>"Current Run:", justify=>"right");
    my $ps2 = $d->add("Entry",
		      -cursor=>undef,
		      -textvariable=>\$data[1],
		      -state=>'disabled',
		      -foreground=>$main::fc,
		      -background=>$main::ec)->pack();

    my $l3 = $d->Label(-text=>"Seconds Since Last Run:", justify=>"left");
    my $ps3 = $d->add("Entry",-cursor=>undef,
			 -textvariable=>\$data[2],
			 -state=>'disabled',
			 -foreground=>$main::fc,
			 -background=>$main::ec)->pack();

    my $l4 = $d->Label(-text=>"CPU busy (sec):", justify=>"right");
    my $ps4 = $d->add("Entry",-cursor=>undef,
			-textvariable=>\$data[3],
			-state=>'disabled',
			-foreground=>$main::fc,
			-background=>$main::ec)->pack();

    my $l5 = $d->Label(-text=>"IO Busy:", justify=>"left");
    my $ps5 = $d->add("Entry",-cursor=>undef,
			-textvariable=>\$data[4],
			-state=>'disabled',
			-foreground=>$main::fc,
			-background=>$main::ec)->pack();

    my $l6 = $d->Label(-text=>"Idle:", justify=>"right");
    my $ps6 = $d->add("Entry",-cursor=>undef,
		      -textvariable=>\$data[5],
		      -state=>'disabled',
		      -foreground=>$main::fc,
		      -background=>$main::ec)->pack();

    my $l7 = $d->Label(-text=>"Packets Received:", justify=>"right");
    my $ps7 = $d->add("Entry",-cursor=>undef,
		    -textvariable=>\$data[6],
		    -state=>'disabled',
		    -foreground=>$main::fc,
		    -background=>$main::ec)->pack();


    my $l8 = $d->Label(-text=>"Packets Sent:", justify=>"right");
    my $ps8 = $d->add("Entry",-cursor=>undef,
			-textvariable=>\$data[7],
			-state=>'disabled',
			-foreground=>$main::fc,
			-background=>$main::ec)->pack();
    
    my $l9 = $d->Label(-text=>"Packet Errors:", justify=>"right");
    my $ps9 = $d->add("Entry",-cursor=>undef,
			  -textvariable=>\$data[8],
			  -state=>'disabled',
			  -foreground=>$main::fc,
			  -background=>$main::ec)->pack();

    my $l10 = $d->Label(-text=>"Total Read:", justify=>"right");
    my $ps10 = $d->add("Entry",-cursor=>undef,
		    -textvariable=>\$data[9],
		    -state=>'disabled',
		    -foreground=>$main::fc,
		    -background=>$main::ec)->pack();

    my $l11 = $d->Label(-text=>"Total Write:", justify=>"right");
    my $ps11= $d->add("Entry",-cursor=>undef,
		    -textvariable=>\$data[10],
		    -state=>'disabled',
		    -foreground=>$main::fc,
		    -background=>$main::ec)->pack();


    my $l12 = $d->Label(-text=>"Total Errors:", justify=>"right");
    my $ps12 = $d->add("Entry",-cursor=>undef,
			-textvariable=>\$data[11],

db/orac_Sybase.pm  view on Meta::CPAN 

   while (@res = $sth->fetchrow) {
       $c_t[$ind_bd_cnt] = $res[0];
       $w = $t->Entry(-textvariable=>\$c_t[$ind_bd_cnt],
		      -cursor=>undef);
       $t->windowCreate('end',-window=>$w);
       
       unless ($uf_type eq 'index'){
	   
	   $sql_entry[$ind_bd_cnt] = "";
	   
	   $w = $t->Entry(-textvariable=>\$sql_entry[$ind_bd_cnt],
			  -cursor=>undef,
			  -foreground=>$main::fc,
			  -background=>$main::ec
                       );

         $t->windowCreate('end',-window=>$w);

      }
      $t_t[$ind_bd_cnt] = "$res[1] $res[2]";

      $w = $t->Entry( -textvariable=>\$t_t[$ind_bd_cnt],
                      -cursor=>undef);

      $t->windowCreate('end',-window=>$w);

      $i_ac[$ind_bd_cnt] = "$res[0]";

      $i_uc[$ind_bd_cnt] = 0;

      $w = $t->Checkbutton( -variable=>\$i_uc[$ind_bd_cnt],
                            -relief=>'flat');

      $t->windowCreate('end',-window=>$w);

      $t->insert('end', "\n");
      $ind_bd_cnt++;
   }
   $ind_bd_cnt--;
   $sth->finish;

   $t->configure( -state=>'disabled' );

   $t->pack( -expand =>1,
             -fill=>'both'
           );

   my $bb = $bd->Frame->pack( -side=>'bottom',
                              -before=> $t
                            );

   if ($uf_type eq 'index'){
      $uf_txt = 'Build Index';
   } else {
      $uf_txt = $main::lg{sel_info};
   }

   $bb->Button( -text=>$uf_txt,
                -command=>sub{ $bd->Busy(-recurse=>1);
                               $self->selector($bd,$uf_type);
                               $bd->Unbusy}
              )->pack (-side=>'right', 
                       -anchor=>'e');

   $bd->Show;
}

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($sel_d,$uf_type) = @_;

   if ($uf_type eq 'index'){
      $self->build_ord($sel_d,$uf_type);
      return;
   }
   $l_sel_str = ' select ';

   my $i;
   for $i (0..$ind_bd_cnt){
      if ($i != $ind_bd_cnt){
         $l_sel_str = $l_sel_str . "$i_ac[$i], ";
      } else {
         $l_sel_str = $l_sel_str . "$i_ac[$i] ";
      }
   }

   $l_sel_str = $l_sel_str . "\nfrom ${own}..${obj} ";

   my $flag = 0;
   my $last_one = 0;

   for $i (0..$ind_bd_cnt){
      if ($i_uc[$i] == 1){
         $flag = 1;
         $last_one = $i;
      }
   }

   my $where_bit = "\nwhere ";
   for $i (0..$ind_bd_cnt){
      my $sql_bit = $sql_entry[$i];
      if (defined($sql_bit) && length($sql_bit)){
         $l_sel_str = $l_sel_str . $where_bit . "$i_ac[$i] $sql_bit ";
         $where_bit = "\nand ";
      }
   }
   
   $self->build_ord($sel_d,$uf_type);
   $self->and_finally($sel_d,$l_sel_str);
}

sub and_finally {
   my $self = shift;

   my($af_d,$cm) = @_;



( run in 1.819 second using v1.01-cache-2.11-cpan-39bf76dae61 )