Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/bin/perl -w use strict; use IO::Socket; use Tk 8.0; use Tk::Checkbutton; use Tk::Menubutton; use Tk::Optionmenu; #--------------------------------------------------- # Begin variable declaration #--------------------------------------------------- my $version = "1.4"; my $mainWindow; my ($menuBar, $fileMenu, $updateMenuItem, $addMenuItem, $deleteMenuIte +m, $configMenuItem, $exitMenuItem, $helpMenu, $aboutMenuItem); my ($labelFrame, $mainFrame, @listFrame); my (@serverList, @portList, @statusList, @deleteCheckbox, @serverDelet +e); my ($serverTitle, $portTitle, $statusTitle, $deleteTitle); my ($buttonFrame, $updateButton, $addButton, $deleteButton, $exitButto +n); my (%config, %servers, %ports); my $serverCount = 0; #--------------------------------------------------- # End variable declaration #--------------------------------------------------- #--------------------------------------------------- # Begin main program #--------------------------------------------------- # First off, see if there's a config file. If not, create it. open (CONFIG, "status.cfg") || &createConfig(); # Pull the servers and ports out of the XML file into a hash my $fileError; open (FH, ".serverlist") or $fileError = 1; if (!$fileError) { while (<FH>) { if (/<server address="(.*?)" name="(.*?)" port="(.*?)" \/>/) { $servers{$2} = $1; $ports{$2} = $3; } } } close (FH); # Just get the number of servers in the list so we can make the list # boxes the right size foreach (keys %servers) { $serverCount++; } # Let's create the interface # # Create the main window where it will all be displayed $mainWindow = MainWindow->new; $mainWindow->title("Server Status"); # End main window creation # Create a simple menubar with a File menu and a Help menu $menuBar = $mainWindow->Frame( -relief => 'groove', -borderwidth => 2) ->pack(-side => 'top', -fill => 'x'); # Create the File menu $fileMenu = $menuBar->Menubutton( -text => 'File', -underline => 0, -tearoff => 0) ->pack(-side => 'left'); $updateMenuItem = $fileMenu->command( -label => 'Update', -underline => 0, -command => sub { \&updateServerList(); }); $addMenuItem = $fileMenu->command( -label => 'Add server', -underline => 0, -command => sub { \&addServerWindow(); }); $deleteMenuItem = $fileMenu->command( -label => 'Delete server(s)', -underline => 0, -command => sub { \&deleteServer(); }); $configMenuItem = $fileMenu->command( -label => 'Configure', -underline => 0, -command => sub { \&configWindow(); }); $exitMenuItem = $fileMenu->command( -label => 'Exit', -underline => 1, -command => sub { exit; }); # Create the Help menu $helpMenu = $menuBar->Menubutton( -text => 'Help', -underline => 0, -tearoff => 0) ->pack(-side => 'right'); $aboutMenuItem = $helpMenu->command( -label => 'About', -underline => 1, -command => sub { \&aboutWindow(); }); # End menubar creation # Create three frames... one for some labels, one for the list boxes, # and one for the buttons $labelFrame = $mainWindow->Frame() ->pack(-side => 'top', -anchor => 'w'); $mainFrame = $mainWindow->Frame() ->pack(-side => 'top'); $buttonFrame = $mainWindow->Frame( -relief => 'groove', -borderwidth => 2) ->pack(-side => 'top', -pady => 10, -fill => 'x'); # End frame creation # Create the list box labels $serverTitle = $labelFrame->Label( -text => "Server", -justify => 'left', -width => 34) ->pack(-side => 'left'); $portTitle = $labelFrame->Label( -text => "Port", -justify => 'right', -width => 6) ->pack(-side => 'left'); $statusTitle = $labelFrame->Label( -text => "Status", -justify => 'right', -width => 6) ->pack(-side => 'left'); $deleteTitle = $labelFrame->Label( -text => "Delete", -justify => 'right', -width => 7) ->pack(-side => 'left'); # End list box label creation # Create the Update, Add, and Exit buttons $updateButton = $buttonFrame->Button( -text => "Update", -underline => 0, -command => sub { \&updateServerList(); }, -width => 6) ->pack(-side => 'left'); $addButton = $buttonFrame->Button( -text => "Add", -underline => 0, -command => sub { \&addServerWindow(); }, -width => 6) ->pack(-side => 'left'); $deleteButton = $buttonFrame->Button( -text => "Delete Selected", -underline => 0, -command => sub { \&deleteServer(); }, -width => 12) ->pack(-side => 'left'); $exitButton = $buttonFrame->Button( -text => "Exit", -underline => 1, -command => sub { exit; }, -width => 6) ->pack(-side => 'right'); # End button creation # Create some key bindings for the buttons and menus $mainWindow->bind('<Alt-Key-u>' => sub { \&updateServerList(); }); $mainWindow->bind('<Alt-Key-a>' => sub { \&addServerWindow(); }); $mainWindow->bind('<Alt-Key-d>' => sub { \&deleteServer(); }); $mainWindow->bind('<Alt-Key-c>' => sub { \&configWindow(); }); $mainWindow->bind('<Alt-Key-x>' => sub { exit; }); $mainWindow->bind('<Alt-Key-b>' => sub { \&aboutWindow(); }); $mainWindow->bind('<Alt-Key-f>' => sub { $fileMenu->Post('','',0); return; }); $mainWindow->bind('<Alt-Key-h>' => sub { $helpMenu->Post('','',0); return; }); # End key bindings # # End interface creation # Read the config file %config = readConfig(); # Fill in the list boxes with server info drawServerList(); # Cause the server info list boxes to refresh $mainWindow->repeat($config{refresh}, \&updateServerList); MainLoop; #--------------------------------------------------- # End main program #--------------------------------------------------- #--------------------------------------------------- # Begin subroutines #--------------------------------------------------- #--------------------------------------------------- # Simply displays an About window sub aboutWindow { $aboutMenuItem->configure(-state => 'disabled'); my $aboutText = " -= Server Status v".$version." =-\n\nWritten by + :\tMike Roessing\nEmail\t :\tjaraxle\@the-den.org\nAddres +s\t :\thttp:\/\/www.the-den.org\n"; my $aboutWindow = $mainWindow->Toplevel(); $aboutWindow->title("About Server Status"); $aboutWindow->focus(); $aboutWindow->resizable(0,0); my $x = $mainWindow->rootx(); my $y = $mainWindow->rooty(); my $xCoord = $x + 38; my $yCoord = $y + 10; $aboutWindow->geometry("250x135+$xCoord+$yCoord"); # Make a top and bottom frame, top for the picture and About info, # bottom for the Done button my $topFrame = $aboutWindow->Frame() ->pack(-side => 'top'); my $bottomFrame = $aboutWindow->Frame() ->pack(-side => 'bottom'); # And now make a frame for the About info inside the topFrame my $aboutFrame = $topFrame->Frame() ->pack(-side => 'left', padx => 15, pady => 10); my $aboutLabel = $aboutFrame->Label( -text => $aboutText, -justify => 'left') ->pack(-side => 'top'); # Put the doneButton in the bottomFrame my $closeButton = $bottomFrame->Button( -text => "Close", -underline => 0, -command => sub { $aboutMenuItem->configure(-state => 'active'); $aboutWindow->destroy(); }, -width => 6) ->pack(-side => 'top'); $aboutWindow->bind("<Alt-Key-c>" => sub { $aboutMenuItem->configure(-state => 'active'); $aboutWindow->destroy(); }); } #--------------------------------------------------- # Add the server and update the list sub addServer { my ($serverNameEntry, $serverIPEntry, $serverPortEntry) = @_; my $serverName = $serverNameEntry->get; my $serverIP = $serverIPEntry->get; my $serverPort = $serverPortEntry->get; # Check if the ip address entered fits the # x(x(x)).x(x(x)).x(x(x)).x(x(x)) format if ((!$serverName) || (!$serverIP) || !($serverIP =~ /^\d{1,3}\.\d +{1,3}\.\d{1,3}\.\d{1,3}$/)) { # Just draw a simple error window explaining the problem my $errorWindow = $mainWindow->Toplevel(); $errorWindow->title("Error"); $errorWindow->focus(); $errorWindow->Label( -text => "\nPlease make sure you entered\nan appropriate S +erver Name.\n") ->pack(-side => 'top') if (!$serverName); $errorWindow->Label( -text => "\nPlease make sure you entered\na valid Server I +P Address.\n") ->pack(-side => 'top') if ((!$serverIP) || !($serverIP =~ +/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/)); my $closeButtonFrame = $errorWindow->Frame() ->pack(-side => 'bottom', -pady => 10); my $closeButton = $closeButtonFrame->Button( -text => "Close", -underline => 0, -command => sub { $errorWindow->destroy(); }, -width => 6) ->pack(-side => 'top'); $errorWindow->bind("<Alt-Key-c>" => sub { $errorWindow->destroy(); }); } else { # Delete the server list clearServerList(); # Add the server and port to the hash and XML file $servers{$serverName} = $serverIP; $ports{$serverName} = $serverPort; &writeServerList(); # Increment the server count and redraw the server list $serverCount++; drawServerList(); # Delete the server info we typed in, ready to add another $serverNameEntry->delete(0, 'end'); $serverIPEntry->delete(0, 'end'); $serverPortEntry->delete(0, 'end'); } } #--------------------------------------------------- # Allow the user to add a server to the list sub addServerWindow { # Disable the Add button and menu item while the window is open $addButton->configure(-state => 'disabled'); $addMenuItem->configure(-state => 'disabled'); # Draw the Add window my $addServerWindow = $mainWindow->Toplevel(); $addServerWindow->title("Add a server"); $addServerWindow->resizable(0,0); my $x = $mainWindow->rootx(); my $y = $mainWindow->rooty(); my $xCoord = $x + 11; my $yCoord = $y + 10; $addServerWindow->geometry("310x170+$xCoord+$yCoord"); # Create one frame for the text entry boxes, another frame for the # buttons my $topFrame = $addServerWindow->Frame() ->pack(-side => 'top'); my $bottomFrame = $addServerWindow->Frame( -relief => 'groove', -borderwidth => 2) ->pack(-side => 'top', -pady => 10, -fill => 'x'); # Draw the text entry boxes, with labels (give the Server Name entry # focus) my $serverNameLabel = $topFrame->Label( -text => "Server Name") ->pack(-side => 'top'); my $serverNameEntry = $topFrame->Entry( -width => 50) ->pack(-side => 'top'); $serverNameEntry->focus(); my $serverIPLabel = $topFrame->Label( -text => "Server IP Address") ->pack(-side => 'top'); my $serverIPEntry = $topFrame->Entry( -width => 50) ->pack(-side => 'top'); my $serverPortLabel = $topFrame->Label( -text => "Server Port") ->pack(-side => 'top'); my $serverPortEntry = $topFrame->Entry( -width => 10) ->pack(-side => 'top'); # Draw the buttons to add the server, clear the entered info, and clos +e # the Add window my $addServerButton = $bottomFrame->Button( -text => "Add", -underline => 0, -command => sub { &addServer($serverNameEntry, $serverIPEntry, $serverPortEn +try); $serverNameEntry->focus(); }, -width => 6) ->pack(-side => 'left'); my $resetButton = $bottomFrame->Button( -text => "Reset", -underline => 0, -command => sub { $serverNameEntry->delete(0, 'end'); $serverIPEntry->delete(0, 'end'); $serverNameEntry->focus(); }, -width => 6) ->pack(-side => 'left'); my $closeButton = $bottomFrame->Button( -text => "Close", -underline => 0, -command => sub { $addServerWindow->destroy(); $addButton->configure(-state => 'active'); $addMenuItem->configure(-state => 'active'); }, -width => 6) ->pack(-side => 'right'); # Create the bindings for the buttons $addServerWindow->bind('<Alt-Key-a>' => sub { &addServer($serverNameEntry, $serverIPEntry); $serverNameEntry->focus(); }); $addServerWindow->bind('<Alt-Key-r>' => sub { $serverNameEntry->delete(0, 'end'); $serverIPEntry->delete(0, 'end'); $serverNameEntry->focus(); }); $addServerWindow->bind('<Alt-Key-c>' => sub { $addServerWindow->destroy(); $addButton->configure(-state => 'active'); $addMenuItem->configure(-state => 'active'); }); } #--------------------------------------------------- # Pretty self explanatory... clears the list boxes of info then redraw +s # them after a short delay (for that "refresh" look) sub clearServerList { # I wish i could avoid using $serverCount altogether but as of now, # with my ability, the deletion requires it for (0..$serverCount-1) { $listFrame[$_]->destroy(); } } #--------------------------------------------------- # Simply displays the Configuration window sub configWindow { $configMenuItem->configure(-state => 'disabled'); my $configWindow = $mainWindow->Toplevel(); $configWindow->title("Server Status Configuration"); $configWindow->focus(); $configWindow->resizable(0,0); my $x = $mainWindow->rootx(); my $y = $mainWindow->rooty(); my $xCoord = $x + 58; my $yCoord = $y + 10; $configWindow->geometry("215x130+$xCoord+$yCoord"); # Temp variables for the colors, if the user hits cancel, # these will be used to revert back to original colors my $tempConfigUpColor = $config{color_up}; my $tempConfigDownColor = $config{color_down}; # Make a top and bottom frame, top for the config info, # bottom for the Close button my $topFrame = $configWindow->Frame() ->pack(-side => 'top'); my $bottomFrame = $configWindow->Frame( -relief => 'groove', -borderwidth => 2) ->pack(-side => 'bottom', -pady => 10, -fill => 'x'); # Make the frames for each option setting my $configUpFrame = $topFrame->Frame() ->pack(-side => 'top', -fill => 'x'); my $configDownFrame = $topFrame->Frame() ->pack(-side => 'top', -fill => 'x'); my $configRefreshFrame = $topFrame->Frame() ->pack(-side => 'top', -fill => 'x'); # Add the label and optionmenu for the Up color my $configUpLabel = $configUpFrame->Label( -text => "Up status color:\t", -justify => 'left', -width => 20) ->pack(side => 'left'); my $configUpOptionmenu = $configUpFrame->Optionmenu( -options => [qw(red blue green yellow black)], -variable => \$config{color_up}) ->pack(-side => 'right'); # Add the label and optionmenu for the Down color my $configDownLabel = $configDownFrame->Label( -text => "Down status color:\t", -justify => 'left', -width => 20) ->pack(side => 'left'); my $configDownOptionmenu = $configDownFrame->Optionmenu( -options => [qw(red blue green yellow black)], -variable => \$config{color_down}) ->pack(-side => 'right'); # Add the label and optionmenu for the refresh rate my $refreshSeconds = $config{refresh} / 1000; my $configRefreshLabel = $configRefreshFrame->Label( -text => "Refresh (seconds):\t", -justify => 'left', -width => 20) ->pack(side => 'left'); my $configRefreshEntry = $configRefreshFrame->Entry( -width => 5, -textvariable => \$refreshSeconds) ->pack(-side => 'right'); # Put the saveButton in the bottomFrame # Will write the new settings to the config file, close # the options window, then refresh the server list my $saveButton = $bottomFrame->Button( -text => "Save", -underline => 0, -command => sub { &writeConfig($configRefreshEntry); $configMenuItem->configure(-state => 'active'); $configWindow->destroy(); &updateServerList(); }, -width => 6) ->pack(-side => 'left'); # Put the cancelButton in the bottomFrame # Will revert the colors back to original, close the # options window, then refresh the server list my $cancelButton = $bottomFrame->Button( -text => "Cancel", -underline => 0, -command => sub { $config{color_up} = $tempConfigUpColor; $config{color_down} = $tempConfigDownColor; $configMenuItem->configure(-state => 'active'); $configWindow->destroy(); &updateServerList(); }, -width => 6) ->pack(-side => 'right'); # Same as hitting the saveButton $configWindow->bind("<Alt-Key-s>" => sub { &writeConfig($configRefreshEntry); $configMenuItem->configure(-state => 'active'); $configWindow->destroy(); &updateServerList(); }); # Same as hitting the cancelButton $configWindow->bind("<Alt-Key-c>" => sub { $config{color_up} = $tempConfigUpColor; $config{color_down} = $tempConfigDownColor; $configMenuItem->configure(-state => 'active'); $configWindow->destroy(); &updateServerList(); }); } #--------------------------------------------------- # Called at the beginning of the program. If the # config file doesn't exist, a default will be made sub createConfig { $config{color_up} = "green"; $config{color_down} = "red"; $config{refresh} = "60000"; open (CONFIG, ">status.cfg") || die "Cannot open file: status.cfg: $!\n"; print CONFIG "<opt>\n"; print CONFIG " <config color_up=\"".$config{color_up}."\" />\n"; print CONFIG " <config color_down=\"".$config{color_down}."\" />\ +n"; print CONFIG " <config refresh=\"".$config{refresh}."\" />\n"; print CONFIG "</opt>\n"; close (CONFIG); } #--------------------------------------------------- # An error window in case you hit Delete without selecting a server sub deleteError { my $errorText = "\nYou must select a server to delete!\n"; my $errorWindow = $mainWindow->Toplevel(); $errorWindow->title("Error"); $errorWindow->focus(); # Make a top and bottom frame, top for the picture and About info, # bottom for the Done button my $topFrame = $errorWindow->Frame() ->pack(-side => 'top'); my $bottomFrame = $errorWindow->Frame() ->pack(-side => 'bottom'); # And now make a frame for the About info inside the topFrame my $messageLabel = $topFrame->Label( -text => $errorText, -justify => 'left') ->pack(-side => 'top'); # Put the doneButton in the bottomFrame my $closeButton = $bottomFrame->Button( -text => "Close", -underline => 0, -command => sub { $errorWindow->destroy(); }, -width => 6) ->pack(-side => 'top'); $errorWindow->bind("<Alt-Key-c>" => sub { $errorWindow->destroy(); }); } #--------------------------------------------------- # Delete the server(s) selected and update the list sub deleteServer { my $deleted = 0; my $i = 0; # Ugh, I hate having to do it this way, but whatever foreach my $serverName (sort(keys %servers)) { # If the checkbox is selected... if ($serverDelete[$i]) { # unselect the checkbox... $deleteCheckbox[$i]->deselect(); # grab the server name... my $serverToDelete = $serverList[$i]->get(0); # delete the server and from the hash... delete $servers{$serverToDelete}; delete $ports{$serverToDelete}; $deleted++; } $i++; } if ($deleted == 0) { &deleteError(); } &writeServerList(); # and update the server list and number of servers we have &updateServerList(); $serverCount = $serverCount - $deleted; } #--------------------------------------------------- # Fills the list boxes with the server name and status (Up or Down) sub drawServerList { # Draw the list boxes for the server and status info, each set in # their own frame my $i = 0; foreach my $server (keys %servers) { $listFrame[$i] = $mainFrame->Frame() ->pack(-side => 'top'); $serverList[$i] = $listFrame[$i]->Listbox( -background => 'white', -height => 1, -width => 34) ->pack(-side => 'left'); $portList[$i] = $listFrame[$i]->Listbox( -background => 'white', -height => 1, -width => 6) ->pack(-side => 'left'); $statusList[$i] = $listFrame[$i]->Listbox( -background => 'white', -height => 1, -width => '6') ->pack(-side => 'left'); $deleteCheckbox[$i] = $listFrame[$i]->Checkbutton( -variable => \$serverDelete[$i]) ->pack(-side => 'left'); $i++; } $i = 0; foreach my $server (sort(keys %servers)) { # Put the server name in its list box $serverList[$i]->insert('end', $server); $portList[$i]->insert('end', $ports{$server}); # Open a socket connection to the specified port on each ip address my $s = IO::Socket::INET->new( PeerHost => $servers{$server}, PeerPort => $ports{$server}, Timeout => 2, Proto => 'tcp'); if ($s) { # If the socket is created, color the text the up color and the # status is "Up" close ($s); $statusList[$i]->configure(-foreground => $config{color_up +}); $statusList[$i]->insert('end', "Up"); } else { # If the socket is not created, color the text the down color and # the status is "Down" $statusList[$i]->configure(-foreground => $config{color_do +wn}); $statusList[$i]->insert('end', "Down"); } # Update the main window after each server so the program doesn't # look like it has stalled $mainWindow->update; $i++; } } #--------------------------------------------------- # Reads the config file for color/refresh info sub readConfig { my %config; open (CONFIG, "status.cfg") || die "Cannot open file: status.cfg: $!\n"; while (<CONFIG>) { $config{color_up} = $1 if (/<config color_up="(.*?)"/); $config{color_down} = $1 if (/<config color_down="(.*?)"/); $config{refresh} = $1 if (/<config refresh="(.*?)"/); } close (CONFIG); return %config; } #--------------------------------------------------- # Just runs the clearServerList and drawServerList subroutines # (mainly for the $mainWindow->repeat(); before MainLoop; above) sub updateServerList { clearServerList(); drawServerList(); } #--------------------------------------------------- # Simply writes the changed configuration out to # the configuration file sub writeConfig { my ($configRefreshEntry) = @_; $config{refresh} = $configRefreshEntry->get * 1000; open (CONFIG, ">status.cfg") || die "Cannot open file: status.cfg: $!\n"; print CONFIG "<opt>\n"; print CONFIG " <config color_up=\"".$config{color_up}."\" />\n"; print CONFIG " <config color_down=\"".$config{color_down}."\" />\ +n"; print CONFIG " <config refresh=\"".$config{refresh}."\" />\n"; print CONFIG "</opt>\n"; close (CONFIG); } #--------------------------------------------------- # Write the server list to the .serverlist file # Called when a server is added or deleted sub writeServerList { open (SERVERLIST, ">.serverlist") || die "Cannot open file: .serverlist: $!\n"; print SERVERLIST "<opt>\n"; foreach my $key (sort(keys %servers)) { print SERVERLIST " <server address=\"$servers{$key}\" name=\" +$key\" port=\"$ports{$key}\" />\n"; } print SERVERLIST "</opt>\n"; close (SERVERLIST); } #--------------------------------------------------- # End subroutines #---------------------------------------------------

In reply to Server Status Monitor by xjar

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others making s'mores by the fire in the courtyard of the Monastery: (7)
    As of 2014-12-27 03:08 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (176 votes), past polls