- 论坛徽章:
- 0
|
本帖最后由 黑色阳光_cu 于 2011-03-05 21:07 编辑
- use strict;
- use warnings;
- use IO::Socket::INET;
- use Fcntl;
- use POSIX qw(EAGAIN);
- my @socks;
- my $listener = IO::Socket::INET->new
- (
- Listen => 5,
- LocalAddr => "localhost",
- LocalPort => 9000,
- Proto => "tcp",
- );
- fcntl($listener, F_SETOWN, $);
- fcntl($listener, F_SETFL, O_ASYNC);
- fcntl($listener, F_SETFL, fcntl($listener, F_GETFL, 0) | O_NONBLOCK);
- my $io_count = 0 ;
- $SIG{IO} = sub { ++$io_count };
- while (1) {
- sleep 60;
- while ($io_count > 0) {
- $io_count--;
- if (my $new_sock = $listener->accept()) {
- fcntl($new_sock, F_SETOWN, $);
- fcntl($new_sock, F_SETFL, O_ASYNC);
- fcntl($new_sock, F_SETFL, fcntl($new_sock, F_GETFL, 0) | O_NONBLOCK);
- push(@socks, $new_sock);
- }
- for (my $n = 0; $n <= $#socks; $n++) {
- if (sysread($socks[$n], my $buf, 8192)) {
- syswrite($socks[$n], $buf);
- }
- else {
- next if ($! == EAGAIN);
- close $socks[$n];
- splice(@socks, $n, 1) && $n--;
- }
- }
- }
- }
复制代码 |
|