view release on metacpan or  search on metacpan

orac_dba.pl  view on Meta::CPAN

sub get_dba_user {

   my($db) = @_;
   my $dba_user;
   my $new_db;

   # Picks up the typical user for the particular database

   my $first_place = File::Spec->catfile($main::orac_home, 'all_dbs.txt');
   my $second_place = File::Spec->catfile($FindBin::RealBin, 'config');
   $second_place = File::Spec->catfile($second_place, 'all_dbs.txt');

   open(DB_FIL, $first_place ) ||
	 open(DB_FIL, $second_place );

   while(<DB_FIL>){
      my @hold = split(/\^/, $_);
      if ($db eq $hold[0]){
         $dba_user = $hold[1];
         $new_db = $hold[2];
      }
   }
   close(DB_FIL);
   return ($dba_user,$new_db);
}

=head2 get_db

Picks up database, and then configures menus accordingly.

=cut

sub get_db {
   # Picks up database, and then configures menus accordingly

   main::get_connected();
   unless (defined($main::current_db)){
     main::back_orac();
   }

   # Run the second initialisation routine
   $main::current_db->init2( $main::dbh );

   # Now sort out Jared's tools and configurable menus

   if (($main::orac_orig_db ne $main::orac_curr_db_typ) ||
       ($main::orac_curr_db_typ =~ /Oracle/)){

      # We do this, if either we're into the program for the first time,
      # or the user has changed the database type

      main::del_Jareds_tools(\$main::jareds_tool);
      main::config_menu();
      main::Jareds_tools();
      $main::orac_orig_db = $main::orac_curr_db_typ;
   }
}

=head2 bz

Makes the main GUI pointer go busy.

=cut

sub bz {
   # Make the main GUI pointer go busy
   $main::mw->Busy(-recurse=>1);
}

=head2 ubz

Makes the main GUI pointer go Un-busy.

=cut

sub ubz {
   # Make the main GUI pointer normalise to unbusy
   $main::mw->Unbusy;
}

sub mes {
   # Produce the box that contains viewable Error

   my $d = $_[0]->DialogBox();

   my $displayer;

   if (length($_[1]) > 200)
   {
      $displayer = $d->Scrolled( 'Text',
			         -setgrid => 1,
                                 -height=>10,
                               );
      $displayer->pack(-expand=>1,-fill=>'both');
      $displayer->insert('end', $_[1]);
   }
   else
   {
      $displayer = $d->Label(-text=>$_[1],
                             -relief=>'flat',
                            );
      $displayer->pack(-expand=>1,-fill=>'both');
   }
   $d->Show;
}

=head2 bc_upd

Change the background colour on all open windows.
Also foregrounds, where not a Canvas.
This is where all those text and window handles come in useful.

=cut

sub bc_upd {

   # Change the background colour on all open windows.
   # This is where all those text and window handles
   # come in useful.

   eval {
      $main::v_text->configure(-background=>$main::bc,
                               -foreground=>$main::fc,
                               -font=>$main::font{name});
   };
   my $comp_str = "";
   my $i;

   my @kids = $main::mw->children();
   foreach my $kid ( @kids )
   {
      if ($kid =~ /Toplevel/)
      {
         if ( exists( $kid->{text} ) )
         {
            eval {
               $kid->{text}->configure(-background=>$main::bc,
                                       -font=>$main::font{name}