view release on metacpan or  search on metacpan

orac_dba.pl  view on Meta::CPAN

      eval $db_init_command;
      if ($@) {
         warn $@;
         main::mes($main::mw,$main::lg{wrong_dbi});
      } else {
         $dn = 1;
      }
   } until $dn;

   # A successful connection means we store the variable for later

   # Pick up the standard DBA user for the particular database
   ($main::sys_user,$main::v_db) = get_dba_user($loc_db);
   main::fill_defaults($loc_db, $main::sys_user, $main::bc, $main::v_db);

   return $loc_db;
}
sub get_dba_user {
   my($db) = @_;
   my $dba_user;
   my $new_db;

   # Picks up the typical DBA user for the particular database

   open(DB_FIL,'config/all_dbs.txt');
   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);
}
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){

      # 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::config_menu();
      main::Jareds_tools();
      $main::orac_orig_db = $main::orac_curr_db_typ;
   }
}

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

   # Takes pointers to which cascade and button the user
   # wishes to run, and sucks SQL info out of the appropriate
   # file, before returning as a Perl string variable

   my($casc,$butt) = @_;
   my $filename = 'tools/sql/' . $casc . '.' . $butt . '.sql';
   my $cm = '';
   open(JARED_FILE, "$filename");
   while(<JARED_FILE>){
      $cm = $cm . $_;
   }
   close(JARED_FILE);
   return $cm;
}

sub mes {
   # Produce the box that contains viewable Error

   my $d = $_[0]->DialogBox();
   my $t = $d->Scrolled( 'Text',
                         -cursor=>undef,
                         -foreground=>$main::fc,
                         -background=>$main::bc);
   $t->pack(-expand=>1,-fil=>'both');
   $t->insert('end', $_[1]);
   $d->Show;
}

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);
   };
   my $comp_str = "";
   my $i;

   my $f;
   foreach $f (keys(%main::swc))
   {
      if (defined($main::swc{$f})){

         print STDERR "main swc f state >" . $main::swc{$f}->state . "< \n" if ($main::debug > 0);

         my $comp_str = $main::swc{$f}->state;

         if("$comp_str" ne 'withdrawn'){
            eval {
               $main::swc{$f}->{text}->configure(-background=>$main::bc);
            }
         }
      }
   }
}