Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
357 lines (266 sloc) 10.1 KB
package POE::Wheel::ListenAccept;
use strict;
use vars qw($VERSION);
$VERSION = '1.288'; # NOTE - Should be #.### (three decimal places)
use Carp qw( croak carp );
use Symbol qw( gensym );
use POSIX qw(:fcntl_h);
use Errno qw(EWOULDBLOCK);
use POE qw( Wheel );
use base qw(POE::Wheel);
sub SELF_HANDLE () { 0 }
sub SELF_EVENT_ACCEPT () { 1 }
sub SELF_EVENT_ERROR () { 2 }
sub SELF_UNIQUE_ID () { 3 }
sub SELF_STATE_ACCEPT () { 4 }
sub CRIMSON_SCOPE_HACK ($) { 0 }
sub new {
my $type = shift;
my %params = @_;
croak "wheels no longer require a kernel reference as their first parameter"
if (@_ && (ref($_[0]) eq 'POE::Kernel'));
croak "$type requires a working Kernel" unless defined $poe_kernel;
croak "Handle required" unless defined $params{Handle};
croak "AcceptEvent required" unless defined $params{AcceptEvent};
my $self = bless [ $params{Handle}, # SELF_HANDLE
delete $params{AcceptEvent}, # SELF_EVENT_ACCEPT
delete $params{ErrorEvent}, # SELF_EVENT_ERROR
&POE::Wheel::allocate_wheel_id(), # SELF_UNIQUE_ID
], $type;
# register private event handlers
$poe_kernel->select($self->[SELF_HANDLE], $self->[SELF_STATE_ACCEPT]);
sub event {
my $self = shift;
push(@_, undef) if (scalar(@_) & 1);
while (@_) {
my ($name, $event) = splice(@_, 0, 2);
if ($name eq 'AcceptEvent') {
if (defined $event) {
$self->[SELF_EVENT_ACCEPT] = $event;
else {
carp "AcceptEvent requires an event name. ignoring undef";
elsif ($name eq 'ErrorEvent') {
$self->[SELF_EVENT_ERROR] = $event;
else {
carp "ignoring unknown ListenAccept parameter '$name'";
sub _define_accept_state {
my $self = shift;
# stupid closure trick
my $event_accept = \$self->[SELF_EVENT_ACCEPT];
my $event_error = \$self->[SELF_EVENT_ERROR];
my $handle = $self->[SELF_HANDLE];
my $unique_id = $self->[SELF_UNIQUE_ID];
# register the select-read handler
( $self->[SELF_STATE_ACCEPT] = ref($self) . "($unique_id) -> select read",
sub {
# prevents SEGV
# subroutine starts here
my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];
my $new_socket = gensym;
my $peer = accept($new_socket, $handle);
if ($peer) {
$k->call($me, $$event_accept, $new_socket, $peer, $unique_id);
elsif ($! != EWOULDBLOCK) {
$$event_error &&
$k->call($me, $$event_error, 'accept', ($!+0), $!, $unique_id);
my $self = shift;
# remove tentacles from our owner
if ($self->[SELF_STATE_ACCEPT]) {
undef $self->[SELF_STATE_ACCEPT];
sub ID {
return $_[0]->[SELF_UNIQUE_ID];
=head1 NAME
POE::Wheel::ListenAccept - accept connections from regular listening sockets
See L<POE::Wheel::SocketFactory/SYNOPSIS> for a simpler version of
this program.
use warnings;
use strict;
use IO::Socket;
use POE qw(Wheel::ListenAccept Wheel::ReadWrite);
inline_states => {
_start => sub {
# Start the server.
$_[HEAP]{server} = POE::Wheel::ListenAccept->new(
Handle => IO::Socket::INET->new(
LocalPort => 12345,
Listen => 5,
AcceptEvent => "on_client_accept",
ErrorEvent => "on_server_error",
on_client_accept => sub {
# Begin interacting with the client.
my $client_socket = $_[ARG0];
my $io_wheel = POE::Wheel::ReadWrite->new(
Handle => $client_socket,
InputEvent => "on_client_input",
ErrorEvent => "on_client_error",
$_[HEAP]{client}{ $io_wheel->ID() } = $io_wheel;
on_server_error => sub {
# Shut down server.
my ($operation, $errnum, $errstr) = @_[ARG0, ARG1, ARG2];
warn "Server $operation error $errnum: $errstr\n";
delete $_[HEAP]{server};
on_client_input => sub {
# Handle client input.
my ($input, $wheel_id) = @_[ARG0, ARG1];
$input =~ tr[a-zA-Z][n-za-mN-ZA-M]; # ASCII rot13
on_client_error => sub {
# Handle client error, including disconnect.
my $wheel_id = $_[ARG3];
delete $_[HEAP]{client}{$wheel_id};
POE::Wheel::ListenAccept implements non-blocking accept() calls for
plain old listening server sockets. The application provides the
socket, using some normal means such as socket(), IO::Socket::INET, or
IO::Socket::UNIX. POE::Wheel::ListenAccept monitors the listening
socket and emits events whenever a new client has been accepted.
Please see L<POE::Wheel::SocketFactory> if you need non-blocking
connect() or a more featureful listen/accept solution.
POE::Wheel::ListenAccept only accepts client connections. It does not
read or write data, so it neither needs nor includes a put() method.
L<POE::Wheel::ReadWrite> generally handles the accepted client socket.
=head2 new
new() creates a new POE::Wheel::ListenAccept object for a given
listening socket. The object will generate events relating to the
socket for as long as it exists.
new() accepts two required named parameters:
=head3 Handle
The C<Handle> constructor parameter must contain a listening socket
handle. POE::Wheel::FollowTail will monitor this socket and accept()
new connections as they arrive.
=head3 AcceptEvent
C<AcceptEvent> is a required event name that POE::Wheel::ListenAccept
will emit for each accepted client socket. L</PUBLIC EVENTS>
describes it in detail
=head3 ErrorEvent
C<ErrorEvent> is an optional event name that will be emitted whenever
a serious problem occurs. Please see L</PUBLIC EVENTS> for more
=head2 event
event() allows a session to change the events emitted by a wheel
without destroying and re-creating the object. It accepts one or more
of the events listed in L</PUBLIC EVENTS>. Undefined event names
disable those events.
Ignore connections:
sub ignore_new_connections {
$_[HEAP]{tailor}->event( AcceptEvent => "on_ignored_accept" );
sub handle_ignored_accept {
# does nothing
=head2 ID
The ID() method returns the wheel's unique ID. It's useful for
storing the wheel in a hash. All POE::Wheel events should be
accompanied by a wheel ID, which allows the wheel to be referenced in
their event handlers.
sub setup_listener {
my $wheel = POE::Wheel::ListenAccept->new(... etc ...);
$_[HEAP]{listeners}{$wheel->ID} = $wheel;
POE::Wheel::ListenAccept emits a couple events.
=head2 AcceptEvent
C<AcceptEvent> names the event that will be emitted for each newly
accepted client socket. It is accompanied by three parameters:
C<$_[ARG0]> contains the newly accepted client socket handle. It's up
to the application to do something with this socket. Most use cases
involve passing the socket to a L<POE::Wheel::ReadWrite> constructor.
C<$_[ARG1]> contains the accept() call's return value, which is often
the encoded remote end of the remote end of the socket.
C<$_[ARG2]> contains the POE::Wheel::ListenAccept object's unique ID.
This is the same value as returned by the wheel's ID() method.
A sample C<AcceptEvent> handler:
sub accept_state {
my ($client_socket, $remote_addr, $wheel_id) = @_[ARG0..ARG2];
# Make the remote address human readable.
my ($port, $packed_ip) = sockaddr_in($remote_addr);
my $dotted_quad = inet_ntoa($packed_ip);
"Wheel $wheel_id accepted a connection from ",
"$dotted_quad port $port.\n"
# Spawn off a session to interact with the socket.
=head2 ErrorEvent
C<ErrorEvent> names the event that will be generated whenever a new
connection could not be successfully accepted. This event is
accompanied by four parameters:
C<$_[ARG0]> contains the name of the operation that failed. This
usually is 'accept', but be aware that it's not necessarily a function
C<$_[ARG1]> and C<$_[ARG2]> hold the numeric and stringified values
of C<$!>, respectively. POE::Wheel::ListenAccept knows how to handle
EAGAIN (and system-dependent equivalents), so this error will never be
C<$_[ARG3]> contains the wheel's unique ID, which may be useful for
shutting down one particular wheel out of a group of them.
A sample C<ErrorEvent> event handler. This assumes the wheels are
saved as in the L</ID> example.
sub error_state {
my ($operation, $errnum, $errstr, $wheel_id) = @_[ARG0..ARG3];
warn "Wheel $wheel_id generated $operation error $errnum: $errstr\n";
delete $_[HEAP]{listeners}{$wheel_id};
=head1 SEE ALSO
L<POE::Wheel> describes the basic operations of all wheels in more
depth. You need to know this.
L<POE::Wheel::ReadWrite> for one possible way to handle clients once
you have their sockets.
The SEE ALSO section in L<POE> contains a table of contents covering
the entire POE distribution.
=head1 BUGS
None known.
Please see L<POE> for more information about authors and contributors.
# rocco // vim: ts=2 sw=2 expandtab
# TODO - Edit.
Something went wrong with that request. Please try again.