#!/usr/bin/perl -w

use strict;

use Errno qw(EPIPE);
use IO::Select;
use IO::Socket::UNIX;

use constant FH   => 0;
use constant RBUF => 1;
use constant WBUF => 2;

sub do_read;
sub do_write;

############################################################################

@ARGV == 1
	or die "Usage: $0 <socket>\n";
my ($filename) = @ARGV;

my $sock = new IO::Socket::UNIX(
	Listen => 1,
	Type   => SOCK_STREAM,
	Local  => $filename,
) or die "Could not create listening socket: $!\n";

# Clean up the socket file on exit
END { unlink $filename if $sock }
$SIG{INT} = $SIG{TERM} = sub { exit };

# We want to see EPIPE
$SIG{PIPE} = 'IGNORE';

# Prepare our reader and writer sets
my $readers = new IO::Select;
my $writers = new IO::Select;
$readers->add($sock);

while (my ($r, $w) = IO::Select::select($readers, $writers)) {

	# Handle ready-for-reading sockets
	foreach my $s (@$r) {
		if ($s == $sock) {
			# If the socket is our listening socket, accept the new connection
			my $new = $sock->accept
				or die "Could not accept connection: $!\n";
			$readers->add([$new, '', '']);
		} else {
			# Otherwise, just read it
			if (do_read $s) {
				$writers->add($s) if length $s->[WBUF];
			} else {
				$readers->remove($s);
				$writers->remove($s);
			}
		}
	}

	# Handle ready-for-writing sockets
	foreach my $s (@$w) {
		# This won't ever be the listening socket
		if (do_write $s) {
			$writers->remove($s) unless length $s->[WBUF];
		} else {
			$readers->remove($s);
			$writers->remove($s);
		}
	}

}

exit;

############################################################################

sub do_read {
	my $s = shift;

	# Attempt to read a page from the socket
	my $read = $s->[FH]->sysread(my $data, 4096);
	defined $read
		or warn "Could not read from socket: $!\n";
	$read
		or return;

	$s->[RBUF] .= $data;

	# Split the data into lines
	while ($s->[RBUF] =~ s/^(.+)\n//) {
		my $line = $1;

		# Process the line here.
		# For this example, we'll just echo the line back.
		$s->[WBUF] .= "$line\n";
	}

	1;
}

sub do_write {
	my $s = shift;

	# Write whatever we've got
	my $written = $s->[FH]->syswrite($s->[WBUF]);
	defined $written or $! == EPIPE
		or warn "Could not write to socket: $!\n";
	$written
		or return;

	# If anything was written, take it out of output buffer
	substr $s->[WBUF], 0, $written, '';

	1;
}