Whiteのふりーとーく

仕事。

About this Page |過去分一覧

近頃版/another blog@hatena/Wiki/BBS

< 準備作業 | 仕事。 >

 

仕事。

作りかけのスクリプト。確立確率試験するための部品だと思いねえ(謎

IO::Pingerは、結局IO::Handleのソースを見ながら適当に書いた。汚いし思った通りに動いてくれてないみたいなのだがとりあえずこれでいいや、ってレベル。

#!/usr/bin/perl
use strict;
no strict qw(subs);
use IO::Select;
use IO::Socket;
my $HOST = "192.168.4.50";
my $selecter = IO::Select->new;
my $pinger = IO::Pinger->new($HOST);
my $logger = new Logger();
print ref($pinger)."\n";
$selecter->add($pinger);
while(1){
    foreach my $sock( $selecter->can_read(1) ){
	my $ret = $sock->solve($logger);
	if($ret eq 'remove'){
	    $selecter->remove($sock);
	}
    }
    exit if($selecter->handles == 0);
}

package Logger;
sub new{
    return bless {};
}
sub ping_false{
    print "ping false.\n";
}
sub ping_ok{
    print "ping ok.\n";
}

package IO::Pinger;
use Symbol;
use IO::Handle;
my(@ISA) = qw(IO::Handle);
sub new{
    my($class)  = shift;
    my($host)   = shift;
    my $io = gensym;
    open($io,"ping -n -c 4 $host | grep 'packet loss' |");
    print ref($io)."\n";
    return bless $io, $class;
}
sub solve{
    my $self   = shift;
    my $logger = shift;
    
    local($_) = <$self>;
    if(/100\% packet loss/){
	$logger->ping_false($_);
	return 'remove';
    }else{
	$logger->ping_ok($_);
	return 'remove';
    }
}

TrackBack ping url:

名前

TrackBack:


御意見・御感想の宛先white@niu.ne.jp