Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
Base.pm	4.65 KB	-rw-rw-rw-	2017-07-19 01:05
DBM.pm	2.56 KB	-rw-rw-rw-	2017-07-19 01:05
DBM.pod	266 B	-rw-rw-rw-	2017-07-19 01:05
Dir.pm	5.38 KB	-rw-rw-rw-	2017-07-19 01:05
Dir.pod	272 B	-rw-rw-rw-	2017-07-19 01:05
File.pm	6.27 KB	-rw-rw-rw-	2017-07-19 01:05
File.pod	268 B	-rw-rw-rw-	2017-07-19 01:05
Filesys.pm	2.67 KB	-rw-rw-rw-	2017-07-19 01:05
Filesys.pod	284 B	-rw-rw-rw-	2017-07-19 01:05
Link.pm	1.15 KB	-rw-rw-rw-	2017-07-19 01:05
Link.pod	268 B	-rw-rw-rw-	2017-07-19 01:05
MLDBM.pm	986 B	-rw-rw-rw-	2017-07-19 01:05
MLDBM.pod	270 B	-rw-rw-rw-	2017-07-19 01:05
Pipe.pm	1.18 KB	-rw-rw-rw-	2017-07-19 01:05
Pipe.pod	268 B	-rw-rw-rw-	2017-07-19 01:05
STDIO.pm	916 B	-rw-rw-rw-	2017-07-19 01:05
STDIO.pod	270 B	-rw-rw-rw-	2017-07-19 01:05
Socket.pm	3.03 KB	-rw-rw-rw-	2017-07-19 01:05
Socket.pod	272 B	-rw-rw-rw-	2017-07-19 01:05
String.pm	528 B	-rw-rw-rw-	2017-07-19 01:05
String.pod	272 B	-rw-rw-rw-	2017-07-19 01:05
Temp.pm	368 B	-rw-rw-rw-	2017-07-19 01:05
Temp.pod	278 B	-rw-rw-rw-	2017-07-19 01:05

Rename

use strict; use warnings;
package IO::All::Socket;

use IO::All -base;
use IO::Socket;

const type => 'socket';
field _listen => undef;
option 'fork';
const domain_default => 'localhost';
chain domain => undef;
chain port => undef;
proxy_open 'recv';
proxy_open 'send';

sub socket {
    my $self = shift;
    bless $self, __PACKAGE__;
    $self->name(shift) if @_;
    return $self->_init;
}

sub socket_handle {
    my $self = shift;
    bless $self, __PACKAGE__;
    $self->_handle(shift) if @_;
    return $self->_init;
}

sub accept {
    my $self = shift;
    use POSIX ":sys_wait_h";
    sub REAPER {
        while (waitpid(-1, WNOHANG) > 0) {}
        $SIG{CHLD} = \&REAPER;
    }
    local $SIG{CHLD};
    $self->_listen(1);
    $self->_assert_open;
    my $server = $self->io_handle;
    my $socket;
    while (1) {
        $socket = $server->accept;
        last unless $self->_fork;
        next unless defined $socket;
        $SIG{CHLD} = \&REAPER;
        my $pid = CORE::fork;
        $self->throw("Unable to fork for IO::All::accept")
          unless defined $pid;
        last unless $pid;
        close $socket;
        undef $socket;
    }
    close $server if $self->_fork;
    my $io = ref($self)->new->socket_handle($socket);
    $io->io_handle($socket);
    $io->is_open(1);
    return $io;
}

sub shutdown {
    my $self = shift;
    my $how = @_ ? shift : 2;
    my $handle = $self->io_handle;
    $handle->shutdown(2)
      if defined $handle;
}

sub _assert_open {
    my $self = shift;
    return if $self->is_open;
    $self->mode(shift) unless $self->mode;
    $self->open;
}

sub open {
    my $self = shift;
    return if $self->is_open;
    $self->is_open(1);
    $self->get_socket_domain_port;
    my @args = $self->_listen
    ? (
        LocalAddr => $self->domain,
        LocalPort => $self->port,
        Proto => 'tcp',
        Listen => 1,
        Reuse => 1,
    )
    : (
        PeerAddr => $self->domain,
        PeerPort => $self->port,
        Proto => 'tcp',
    );
    my $socket = IO::Socket::INET->new(@args)
      or $self->throw("Can't open socket");
    $self->io_handle($socket);
    $self->_set_binmode;
}

sub get_socket_domain_port {
    my $self = shift;
    my ($domain, $port);
    ($domain, $port) = split /:/, $self->name
      if defined $self->name;
    $self->domain($domain) unless defined $self->domain;
    $self->domain($self->domain_default) unless $self->domain;
    $self->port($port) unless defined $self->port;
    return $self;
}

sub _overload_table {
    my $self = shift;
    (
        $self->SUPER::_overload_table(@_),
        '&{} socket' => '_overload_socket_as_code',
    )
}

sub _overload_socket_as_code {
    my $self = shift;
    sub {
        my $coderef = shift;
        while ($self->is_open) {
            $_ = $self->getline;
            &$coderef($self);
        }
    }
}

sub _overload_any_from_any {
    my $self = shift;
    $self->SUPER::_overload_any_from_any(@_);
    $self->close;
}

sub _overload_any_to_any {
    my $self = shift;
    $self->SUPER::_overload_any_to_any(@_);
    $self->close;
}