File Coverage

blib/lib/Coro/PatchSet/Socket.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Coro::PatchSet::Socket;

use strict;
use Coro::Socket;

our $VERSION = '0.12';

package # hide it from cpan
	Coro::Socket;

sub new {
	my ($class, %arg) = @_;

	$arg{Proto} ||= 'tcp';
	defined ($arg{Type}) or $arg{Type} = $arg{Proto} eq "tcp" ? SOCK_STREAM : SOCK_DGRAM;

	socket my $fh, PF_INET, $arg{Type}, _proto ($arg{Proto})
		or return;

	my $self = bless Coro::Handle->new_from_fh (
		$fh,
		timeout       => $arg{Timeout},
		forward_class => $arg{forward_class},
		partial       => $arg{partial},
	), $class
		or return;

	$self->configure (\%arg)
}

sub configure {
	my ($self, $arg) = @_;

	$arg->{LocalHost} ||= delete $arg->{LocalAddr};
	$arg->{PeerHost}  ||= delete $arg->{PeerAddr};

	${*$self}{io_socket_timeout} = $arg->{Timeout};

	my @sa;
	eval {
		if ($arg->{ReuseAddr}) {
			$self->setsockopt (SOL_SOCKET, SO_REUSEADDR, 1)
				or croak "setsockopt(SO_REUSEADDR): $!";
		}

		if ($arg->{ReusePort}) {
			$self->setsockopt (SOL_SOCKET, SO_REUSEPORT, 1)
				or croak "setsockopt(SO_REUSEPORT): $!";
		}

		if ($arg->{Broadcast}) {
			$self->setsockopt (SOL_SOCKET, SO_BROADCAST, 1)
				or croak "setsockopt(SO_BROADCAST): $!";
		}

		if ($arg->{SO_RCVBUF}) {
			$self->setsockopt (SOL_SOCKET, SO_RCVBUF, $arg->{SO_RCVBUF})
				or croak "setsockopt(SO_RCVBUF): $!";
		}

		if ($arg->{SO_SNDBUF}) {
			$self->setsockopt (SOL_SOCKET, SO_SNDBUF, $arg->{SO_SNDBUF})
				or croak "setsockopt(SO_SNDBUF): $!";
		}

		if ($arg->{LocalPort} || $arg->{LocalHost}) {
			@sa = _sa($arg->{LocalHost} || "0.0.0.0", $arg->{LocalPort} || 0, $arg->{Proto});
			$self->bind ($sa[0])
				or croak "bind($arg->{LocalHost}:$arg->{LocalPort}): $!";
		}

		if ($arg->{PeerHost}) {
			@sa = _sa ($arg->{PeerHost}, $arg->{PeerPort}, $arg->{Proto});
		}
	};
	if (my $err = $@) {
		$err =~ s/\s+at\s+.+?line\s+\d+\.//;
		$@ = $err;
		return;
	}

	if ($arg->{PeerHost}) {
		for (@sa) {
			$! = 0;
			if ($self->connect ($_)) {
				next unless writable $self;
				$! = unpack "i", $self->getsockopt (SOL_SOCKET, SO_ERROR);
			}

			$! or return $self;

			$!{ECONNREFUSED} or $!{ENETUNREACH} or $!{ETIMEDOUT} or $!{EHOSTUNREACH}
				or last;
		}

		return;
	}

	if (exists $arg->{Listen}) {
		$self->listen ($arg->{Listen})
			or return;
	}

	$self
}

1;

__END__