最近一直有在学习POE，这是一个类似于状态机的网络框架，在python上有叫twisted的类似框架。为此也看了一些文章，并学习了一些例子。
对于SOCKET编程，也许是很久没有用了的缘故，看到相关的一段程序时，感觉相当地眼生。还因为之前一直是用perl原生的socket命令来写的，所以对IO::Socket没有做过多的了解。再去看书，或者将perldoc里的内容从头到尾地通读一遍，一来没有什么兴趣，二来就以往经验来看很多内容都是很少用到的，看了也容易忘记。所以就将这段代码抄了一遍，对于其中不了解或者有疑问的再去查perldoc，或者写一些测试代码来验证。事实证明收获也是不小，很快就了解了其中的主要内容，顺带地还将POSIX中的一些常量搞搞清楚。更重要的是在抄写这样规范的代码，对于自身编写程序的格式也会有潜移默化的影响。
这么做的关键在于，首先要有一段好的代码，第二不要抱着得过且过的心态放过一些细节。
#!/usr/bin/perl
use warnings;
use strict;
use POSIX;
use IO::Socket;
use IO::Select;
use Tie::RefHash;
# Create the server socket.
my $server = IO::Socket::INET->new(
LocalPort => 12345,
Listen => 10,
) or die "can't make server socket: $@\n";
$server->blocking(0);
# Set structures to track input and output data.
my %inbuffer = ();
my %outbuffer = ();
my %ready = ();
tie %ready, "Tie::RefHash";
# The select loop itself.
$my select = IO::Select->new($server);
while(1) {
# Process sockets that are ready for reading.
foreach my $client( $select->can_read(1) ) {
handle_read($client);
}
# Process any complete requests. Echo the data back to the client,
# by putting the ready lines into the client's output buffer.
foreach my $client ( keys %ready ) {
foreach my $request ( @{ $ready{$client} } ) {
print "Got request: $request\n";
$outbuffer{$client} .= $request;
}
delete $ready{$client};
}
# Process sockets that are ready for writing.
foreach my $client ( $server->can_write(1) ) {
handle_write($client);
}
}
exit;
# Handle a socket that's ready to be read from.
sub handle_read {
my $client = shift;
# If it's the server socket, accept a new client connection.
if ( $client == $server ) {
my $new_client = $server->accept();
$new_client->blocking(0);
$select->add($new_client);
return;
}
# Read from an established client socket.
my $data = "";
my $rv = $client->recv( $data, POSIX::BUFSIZ, 0 );
# Handle socket errors.
unless ( defined($rv) and length($data) ) {
handle_error($client);
return;
}
# Successful read. Buffer the data we got, and parse it into lines.
# Place the lines into %ready, where they will be processed later.
$inbuffer($client) .= $data;
while ( $inbuffer{$client} =~ s/(.*\n)// ) {
push @{ $ready{$client} }, $1;
}
}
# Handle a socket that's ready to be write to.
sub handle_write {
my $client = shift;
# Skip this client if there's nothing write.
return unless exists $outbuffer{$client};
# Attempt to write pending data to the client.
my $rv = $client->send( $outbuffer{$client}, 0 );
unless ( defined $rv ) {
warn "I was told I could write, but I can't.\n";
return;
}
# Successful write. Remove what was sent from the output buffer.
if ( $rv == length( $outbuffer{$client} ) or $! ==POSIX::EWORLDBLOCK ) {
substr( $outbuffer($client), 0, $rv ) = "";
delete $outbuffer{$client} unless length $outbuffer{$client};
return;
}
# Otherwise there was an error.
handle_error($client);
}
# Handle client error. Clean up after dead socket.
sub handle_error {
my $client = shift;
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
$select->remove($client);
close $client;
}