Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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 imbibing at the Monastery: (7)
    As of 2015-07-08 06:27 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (94 votes), past polls