I have three Unix servers running a socket server program that must be up 24/7. I have written some perl scripts that I use to monitor the status of each server program. This is done by making a socket connection to the ipaddr and sending the data 'status'. The servers are programmed to check if the database is available and accessible and then reply with a 0/1 depending on the result. This works, except that you must manually send the data each time by pressing a 'button' on the perl display.

I decided to automate this process by doing a forever loop and within, making the socket connection, sending the data, retrieving back the results, closing the connection, updating the display variables (ovals of a different color - green, yellow, red)to visually show whether the server is operational or not.

My problem is that everything works except for displaying the window. I have tried several different approaches, but it seems that I cannot have a perl script call a subroutine to display and then return so values can be updated and the process be repeated. I used the perl debugger and walked thru the code, and the window subroutine seemed to execute correctly, but the window was never displayed.

I am attaching the code I used, (except subs.pl since that is a large set of subroutines (socket connections, ect), that we use in production).

Any insight or help that you can provide is greatly appreciated. Thank you.

#!/usr/perl5/5.00503/bin/perl
######################################
require "c:\\mevslights2\\subs.pl";
use Tk;
# 

######################################################################
+######
# Define program switches and command execute locations
######################################################################
+######
@ipaddr     = ("shoshone","clark","lewis");
@port       = (4500,5500);        # 4500=online, 5500=batch
$data       = "status";
$system     = "";
$server     = "";
$rc         = "";
#            MevsLights("shoshone", "4500", "0");

while ( 1 )
{
    foreach $server (@ipaddr)     # do for each of the servers
    {
        foreach $system (@port)   # do for each portno  (online/batch)
        {
            #---------------------------------------------------------
+----------------------------
            #  Test status a maximum of 5 times or until a 'good' stat
+us
            #  check return code [$rc] is received. 
            #---------------------------------------------------------
+----------------------------
            $rc  = 9;     # Set return code to non-zero (9) value so t
+he while loop will work
            $cnt = 0;     # Set counter to zero, used to loop max 5 ti
+mes before sending email

            while  (($rc != 0) && ($cnt <= 5))
            {
               $sock = get_socket($server, $system);         # connect
+ to socket

               if ( $sock eq "ERROR"  ) {                    # connect
+ion error
                   $rc = 2;
               }
               else
               {
                  $response = send_request($sock, $data);    # send 's
+tatus' request

                  if    ( $response eq "" )  {$rc = 3;}      # no resp
+onse (timeout)
                  elsif ( $response eq "1" ) {$rc = 1;}      # status 
+check failed
                  elsif ( $response eq "0" ) {$rc = 0;}      # status 
+check passed
                  else  { $rc = $response; }

                  close_socket($sock);                      # close so
+cket
                  $cnt++;                                   # incr loo
+p count
               }
               sleep 5;                                     # sleep fo
+r 5 secs
               $cnt++;                                      # incr loo
+p count
            }
            mevslights();                                   # Turn on 
+the lights
        }
   }
   sleep 5
}
######################################################################
+######
sub mevslights        # User configuration default options
######################################################################
+######
{
    @color      = ("green", "yellow", "red", "red");

    if ( ! Exists($ml) )
    {
        $login_title = "MEVSTOOL: User Security";

        $ml = MainWindow->new;
        $ml->title(" MEVS Monitor:  MevsLights.pl");

        get_time();

        $c = $ml->Canvas(-relief => 'groove')->pack(-fill => 'both', -
+expand => 1);

        # Set the row and column labels for the server (shoshone, lewi
+s, clark) in red, and the system (online, batch)in blue
        $c->createText(40,68, -text => "shoshone", -anchor => "w", -fi
+ll => "dark red", -font => "arial 12 bold");
        $c->createText(40,108, -text => "lewis", -anchor => "w", -fill
+ => "dark red", -font => "arial 12 bold");
        $c->createText(40,148, -text => "clark", -anchor => "w", -fill
+ => "dark red", -font => "arial 12 bold");
        $c->createText(130,30, -text => "Online", -anchor => "w", -fil
+l => "dark blue", -font => "arial 12 bold");
        $c->createText(200,30, -text => "Batch", -anchor => "w", -fill
+ => "dark blue", -font => "arial 12 bold");

        # Turn on the MEVS Lights
        turn_on_lights();    # turn lights on
     }
    else
    {
        turn_on_lights();    # turn lights on
    }

 }
  
######################################################################
+#####
 #####################################################################
+######
 sub turn_on_lights     #02/11/2005 11:47AM
 #####################################################################
+######
  {
    if ( $server eq "shoshone" ) {
        if ($system eq "4500") {           # online
            $c->createOval(140,58,160,78, -fill => "$color[$rc]", outl
+ine => "dark $color[$rc]");
            $data[0] = $rc;
        }
        else  {                           # batch
            $c->createOval(210,58,230,78, -fill => "$color[$rc]", outl
+ine => "dark $color[$rc]");
            $data[1] = $rc;
        }
    }
    elsif ( $server eq "lewis" )  {
        if ($system eq "4500") {           # online
            $c->createOval(140,98,160,118, -fill => "$color[$rc]", out
+line => "dark $color[$rc]");
            $data[2] = $rc;
        }
        else  {                           # batch
            $c->createOval(210,98,230,118, -fill => "$color[$rc]", out
+line => "dark $color[$rc]");
            $data[3] = $rc;
        }
    }
    elsif ( $server eq "clark" )  {
        if ($system eq "4500") {           # online
            $c->createOval(140,138,160,158, -fill => "$color[$rc]", ou
+tline => "dark $color[$rc]");
            $data[4] = $rc;
        }
        else  {                           # batch
            $c->createOval(210,138,230,158, -fill => "$color[$rc]", ou
+tline => "dark $color[$rc]");
            $data[5] = $rc;
        }
    }
 }  ##turn_on_lights
 #####################################################################
+######
 1;
[download]

Gerry

geraldg@clemson.edu