#!/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 up 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"; $outbuffer{$client} .= $request; } delete $ready{$client}; } # Process sockets that are ready for writing. foreach my $client ($select->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 written to. sub handle_write { my $client = shift; # Skip this client if there's nothing to 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::EWOULDBLOCK) { substr($outbuffer{$client}, 0, $rv) = ""; delete $outbuffer{$client} unless length $outbuffer{$client}; return; } # Otherwise there was an error. handle_error($client); } ### Handle client errors. Clean up after the dead socket. sub handle_error { my $client = shift; delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client}; $select->remove($client); close $client; }