近頃版/another blog@hatena/Wiki/BBS
< 仕事。 | 進捗 >
機能のスクリプトのその後。相変わらず@ISAをちゃんと処理してくれないのが謎。しかしそのへんは本筋ではなく、目的の動作は果たせているようなのでこのままでよかろう。
_これで単純作業はこんぴうた君に任せることができるようになったので私は別の調べ物へ。
#!/usr/bin/perl use strict; no strict qw(subs); use IO; use IO::Select; use IO::Socket; my $HOST = "192.168.4.50"; my $selecter = IO::Select->new; my $logger = new Logger(); for(my $i = 0;$i < 100;$i++){ $logger->test_start; sleep(3); $selecter->add( IO::PPPD->new() ); while(1){ foreach my $sock( $selecter->can_read() ){ my $ret = $sock->solve($logger); if(ref($ret)){ $selecter->add($ret); }elsif($ret eq 'remove'){ $selecter->remove($sock); } } last if($selecter->handles == 0); if($logger->{current}->{ping}&& !$logger->{current}->{kill}){ open(PS,'ps -a | grep pppd |'); while(<PS>){ /^\s*(\d+)/; my $pid = $1; kill 15,$pid; } $logger->{current}->{kill} = 1; } } } $logger->final_report; exit; package Logger; sub new{ return bless { list => [] }; } sub test_start{ my $self = shift; if(defined $self->{current}){ push($self->{list},$self->{current}); } $self->{current} = {}; $self->{current}->{ping} = 0; } sub message{ my $self = shift; my $mes = shift; print $mes."\n"; } sub ping_false{ my $self = shift; print "ping false.\n"; $self->{current}->{ping} = 0; } sub ping_ok{ my $self = shift; print "ping ok.\n"; $self->{current}->{ping} = 1; } sub final_report{ my $self = shift; $self->test_start; my($ok,$total); $total = scalar($self->{list}); foreach($self->{list}){ if($_->{ping} == 1){ $ok++; } } printf("%4d/%4d : %d%% success\n",$ok,$total,($ok / $total)); } package IO::PPPD; use Symbol; our(@ISA); @ISA = qw(IO::Handle); sub new{ my $class = shift; my $io = gensym; open($io,"/etc/ppp/ppp-on 2>&1 |"); bless $io, $class; } sub solve{ my $self = shift; my $logger = shift; if(eof($self)){ $logger->message("eof pppd"); return 'remove'; } $_ = <$self>; print " ".$_; if(/ip\-up finished/){ $logger->message("ip-up finished"); my $pinger = IO::Pinger->new("192.168.251.2"); return $pinger; } if(/Modem hangup/){ $logger->message("modem hangup"); return 'remove'; } } package IO::Pinger; use Symbol; our(@ISA); @ISA = qw(IO::Handle); sub new{ my($class) = shift; my($host) = shift; my $io = gensym; open($io,"LANG=C ping -c 4 $host | grep 'packet loss' |"); return bless $io, $class; } sub solve{ my $self = shift; my $logger = shift; if(eof($self)){ $logger->message("eof pinger"); return 'remove'; } local($_) = <$self>; print; if(/packet loss/){ if(/100\% packet loss/){ $logger->ping_false($_); return 'remove'; }else{ $logger->ping_ok($_); return 'remove'; } } }