#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Net::Ping;

my ( $ip, $hostname, $mw, $hostfile, $int, $frame, $stat, %list, $body
+ );

# Process arguements
while ( @ARGV and $ARGV[0] =~ /^-/ ) {
    $_ = shift;
    last if /^--$/;
    if    (/^-f(.*)/) { $hostfile = $1 }
    elsif (/^-i(.*)/) { $int      = $1 }
    else { usage(); }
}

# Set default values if no arguments were supplied
unless ( defined($hostfile) ) { $hostfile = "/etc/hosts" }
unless ( defined($int) )      { $int      = "30" }

open HOSTFILE, "< $hostfile" or die "can't read $hostfile: $!";

# Create a hash of the hostfile; omitting comments, localhost, and
# blank lines 
while (<HOSTFILE>) {
    s/#.*//;    # remove any comments
    next if /^\s+$/;
    next if /^127\./;
    ( $ip, $hostname ) = split;
    $list{$hostname}{hostname} = $hostname;
    $list{$hostname}{ip}       = $ip;

    my ( $status, $color, $p );
    $p = Net::Ping->new("icmp");
    if ( $p->ping( $ip, 1 ) ) {
        $list{$hostname}{status} = "UP";
        $list{$hostname}{color}  = "green";
    }
    else {
        $list{$hostname}{status} = "DOWN";
        $list{$hostname}{color}  = "red";
    }
}

$mw = MainWindow->new();
$mw->title("NetMon Tool");
$mw->geometry('+10+10');
$mw->configure( -background => "black" );

# create topmenu menu
my $tm = $mw->Frame(
    -relief      => 'groove',
    -borderwidth => 3,
    -background  => 'white',
  )->pack(
    -side => 'top',
    -fill => 'x'
  );

# create frames
$body = $mw->Frame( -background => "black", )->pack(
    -side => 'top',
    -fill => 'x'
);

sub pingagain {    # Ping each host once and label UP or DOWN
    my ( $host, $p );
    $p = Net::Ping->new("icmp");
    foreach $host ( keys %list ) {
        if ( $p->ping( $list{$host}{ip}, 1 ) ) {
            $list{$host}{status}    = "UP";
            $list{$hostname}{color} = "green";
            $stat->configure(-background => 'green');            
    }
        else {
            $list{$host}{status}    = "DOWN";
            $list{$hostname}{color} = "red";
            $stat->configure(-background => 'red');
        
    }
    }
    textdisp();
}

sub textdisp {
    my ($host);

    #    system("clear");
    foreach $host ( keys %list ) {
        print "$list{$host}{hostname}   \t";
        print "$list{$host}{ip}\t";
        print "$list{$host}{status}\n";
    }
}

sub usage {
    print STDERR <<"_EOT_";

Usage: netmon <options>

Where options are:

-i<interval>                    : The interval, in seconds, at
which
netmon should ping hosts
Default: 30
-f<filename>                    : The configuration file
containing
space delimited IP addresses
and
hostnames to be monitored.
Default: /etc/hosts

Example: netmon -i5 -f/tmp/myhostfile

_EOT_
    exit(1);
}

sub statdisp {
    my ($host);
    foreach $host ( keys %list ) {

        $frame = $body->Frame( -background => "$list{$host}{color}", )
+->pack(
            -side => 'top',
            -fill => 'x'
        );

        $stat = $frame->Label( -background => "$list{$host}{color}" )-
+>pack(
            -padx   => 12,
            -side   => "left",
            -expand => 1,
            -fill   => "x"
        );
        $stat->configure( -text => $list{$host}{hostname} );

        $stat = $frame->Label( -background => "$list{$host}{color}" )-
+>pack(
            -padx   => 16,
            -side   => "left",
            -expand => 1,
            -fill   => "x"
        );
        $stat->configure( -text => $list{$host}{ip} );

        $stat = $frame->Label( -background => "$list{$host}{color}" )-
+>pack(
            -padx => 4,
            -side => "right",
        );
        $stat->configure( -text => "$list{$host}{status}" );
    }
}

textdisp();
statdisp();
$mw->repeat( 1000, \&pingagain );
$mw->update;
MainLoop();
[download]

#!/usr/bin/perl -w
use Tk;
use Tk::Menubar;
use Cwd;
require Tk::Dialog;
require Tk::ROText;
use strict;

#-------------------------------------------------------------------
# Main Window Setup and configuration
#-------------------------------------------------------------------

my $MW = MainWindow->new();
$MW->title("TESTGUI ");

#-------------------------------------------------------------------
# Menubar
#-------------------------------------------------------------------

my $menubar = $MW->Menubar;

#-------------------------------------------------------------------
# Menubuttons
#-------------------------------------------------------------------

my $f   = $menubar->Menubutton( -text => 'File', -underline => 0 );
my $run = $menubar->Menubutton( -text => 'Run',  -underline => 0 );

#-------------------------------------------------------------------
# Menu sub-buttons
#-------------------------------------------------------------------

$f->command( -label => 'Close', -command => sub { exit }, -underline =
+> 0 );
$run->command( -label => 'RUN PING COMMAND', -command => [ \&run_pc ] 
+);

#-------------------------------------------------------------------
# Frame 1  - INPUT VARIABLES FRAME (Main body frame)
#-------------------------------------------------------------------
my $N    = 1;
my $frm1 = $MW->Frame;

my $tl1 = $frm1->Label(
    -text => "NOT IMPORTANT, JUST USED SPACE FOR
SETTING VARIABLES",
    -relief     => 'raised',
    -background => "gray"
  )->grid(
    -row        => 0,
    -column     => 0,
    -sticky     => 'nsew',
    -columnspan => 2
  );

$frm1->pack;

MainLoop;

#-------------------------------------------------------------------
# Run PC subroutine
#-------------------------------------------------------------------

sub run_pc {
    my $pcwin = new MainWindow( -title => "PC OUTPUT LOG WINDOW" );
    `ping -c 20 localhost > pc_output.log &`;
    my $pidpc = open( RUNCOMMANDD, "tail -f pc_output.log |" )
      || die $!;
    my $outputtext = $pcwin->Scrolled(
        "Text",
        -scrollbars => "e",
        -width      => 80,
        -height     => 45,
        -wrap       => "word"
    )->pack();
    my $quitbutn = $pcwin->Button(
        -text    => "Close",
        -command => sub {
            close(RUNCOMMANDD);
            kill 'TERM', $pidpc;
            `echo "bye" >>
pc_output.log`;
            $pcwin->fileevent( \*RUNCOMMANDD, 'readable' => '' );
            $pcwin->destroy;
        }
    )->pack();
    $pcwin->fileevent( \*RUNCOMMANDD, 'readable',
        [ \&fill_text_widget, $outputtext ] );
}

sub fill_text_widget {

    my ($widgett) = @_;
    my ( $stat, $data );
    $stat = sysread( RUNCOMMANDD, $data, 4096 );
    die "sysread error:  $!" unless defined $stat;
    $widgett->insert( 'end', $data );
    $widgett->yview('end');

}
[download]