use strict; use mship; use Tk; my $host; $|++; #First create a new mainwindow my $mainwindow = new Tk::MainWindow(); #Then create a textwidget (called 'Scrolled', with subtype 'Text") my $text = $mainwindow->Scrolled("Text", -scrollbars => 'se')->pack(-expand => 1, -fill => 'both'); for ( 0 .. 54 ) { get($_); last if ($_ == 53 ) } # create a closebutton my $button = $mainwindow->Button(-text => "close", -command => sub {$mainwindow->destroy()})->pack(); # start the main loop! MainLoop; sub get { my $node = shift; $host = sprintf ("%02d", $node) ; my %status = mship::connection("192.9.210.1$host", "13"); my $stats=($status{status} == 0) ? "Up" : "Down"; $text->insert('end', "$status{remote_name} is $stats\n"); } #### use strict; use warnings; package mship; use IO::Socket::INET; use Socket; use Carp; =head1 NAME mship - The mothership connection or how I learned to stop worrying and trust the script. =head1 VERSION Version 0.04 =cut our $VERSION = '0.04'; =head1 SYNOPSIS use mship; my %status=mship::connection('IP', 'TCP_PORT'); my $status=mship::mstat('HOST', 'TCP_PORT') ? "Up" : "Down"; ... =head1 FUNCTIONS =head2 connection =cut ############## sub connection ############## { my $IP = shift; my $TCP_PORT = shift; my ( $ipadd, $port_name, $remote_name ); $ipadd = Socket::inet_aton($IP) or croak "$IP is not valid\n"; $port_name = getservbyport($TCP_PORT, 'tcp') or $port_name = "unknown"; $remote_name = gethostbyaddr( $ipadd, 2 ) or print "Unable to resolve hostname for $IP\n"; my %stats = ( 'IP' => $IP, 'PORT' => $TCP_PORT, 'port_name' => $port_name, 'remote_name' => $remote_name, 'status' => &mstat($IP, $TCP_PORT) ); return %stats or carp "unable to return the value of \%stats\n";; } =head2 mstat =cut ############# sub mstat ############# { my ( $host, $tcp_port ) = @_; my $isvalid = Socket::inet_aton($host) or croak "$host is not valid\n"; my $sock = IO::Socket::INET ->new( Timeout => 2, PeerAddr => $host, PeerPort => $tcp_port, Proto => 'tcp' ); return $sock ? 1 : 0; carp "Unable to return $sock\n"; } =head1 AUTHOR Ted Fiedler, C<< >> =head1 BUGS Please report any bugs or feature requests to C =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2003, 2004, 2005 Ted Fiedler, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of mship