view release on metacpan or  search on metacpan

lib/ControlFreak/Socket.pm  view on Meta::CPAN

Each socket object has a unique name inside B<ControlFreak> controller,
services interested in a socket just reference it using this name.
The controller pipes the socket to children's stdin after forking,
and before executing the service.

=head1 METHODS

=head2 new(%param)

Creates a socket objects. Params are:

=over 4

=item * ctrl

The controller to attach the socket to. If not specified, the
socket object won't be created, C<new()> will just return undef.

=item * name

The name of the socket, MUST be unique within C<ctrl>.

=item * host

eg. '127.0.0.0', '0.0.0.0', 'unix/', '[::1]'.

=item * service

eg. '80', '/tmp/cfk.sock'.

=back

If a socket with that name already exists, it will return undef
and log the error.

=cut

sub new {
    my $class = shift;
    my %param = @_;

    delete $param{fh};
    my $ctrl = $param{ctrl};
    unless ($ctrl) {
        warn "Socket creation attempt without ctrl";
        return;
    }

    unless ($param{name}) {
        $ctrl->log->error("Socket creation attempt without a name");
        return;
    }

    my $socket = $class->SUPER::new(%param);
    $socket->{ctrl} = $ctrl;
    unless ($ctrl->add_socket($socket)) {
        $ctrl->log->error("A socket by that name already exists");
        return;
    }
    Scalar::Util::weaken($socket->{ctrl});
    return $socket;
}

=head2 bind

Creates, binds the socket and puts it in listen mode, then returns
immediately.
Once bound, $socket->fh will return the filehandle.

=cut

sub bind {
    my $socket = shift;

    my $ctrl = $socket->{ctrl};
    my $name = $socket->name;
    if ($socket->{fh}) {
        $ctrl->log->error("'$name' socket is already bound");
        return;
    }

    my ($fh, $host, $service) = $socket->_bind;
    unless ($fh) {
        $ctrl->log->error("cannot bind '$name': $!");
        return;
    }
    $ctrl->log->info("'$name' socket is now bound: $fh");
    ## reset with real values
    $socket->{service} = $service;
    $socket->{host}    = $host;
    $socket->{fh}      = $fh;
    return;
}

sub _bind {
    my $socket = shift;

    my $host = $socket->host;
    my $service = $socket->service;

    ## part reaped from AnyEvent::Socket

    my $ipn = AnyEvent::Socket::parse_address($host)
        or Carp::croak "AnyEvent::Socket::tcp_server: "
                     . "cannot parse '$host' as host address";

    my $af = AnyEvent::Socket::address_family($ipn);

    my $fh;

    # win32 perl is too stupid to get this right :/
    Carp::croak "tcp_server/socket: address family not supported"
        if AnyEvent::WIN32 && $af == AF_UNIX;

    socket $fh, $af, SOCK_STREAM, 0
        or Carp::croak "tcp_server/socket: $!";

   if ($af == AF_INET || $af == AF_INET6) {
       setsockopt $fh, SOL_SOCKET, SO_REUSEADDR, 1
           or Carp::croak "tcp_server/so_reuseaddr: $!"