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


line stmt bran cond sub pod time code
1             package Coro::PatchSet::Socket;
2              
3 3     3   41678 use strict;
  3         7  
  3         77  
4 3     3   3125 use Coro::Socket;
  0            
  0            
5              
6             our $VERSION = '0.12';
7              
8             package # hide it from cpan
9             Coro::Socket;
10              
11             sub new {
12             my ($class, %arg) = @_;
13            
14             $arg{Proto} ||= 'tcp';
15             defined ($arg{Type}) or $arg{Type} = $arg{Proto} eq "tcp" ? SOCK_STREAM : SOCK_DGRAM;
16            
17             socket my $fh, PF_INET, $arg{Type}, _proto ($arg{Proto})
18             or return;
19            
20             my $self = bless Coro::Handle->new_from_fh (
21             $fh,
22             timeout => $arg{Timeout},
23             forward_class => $arg{forward_class},
24             partial => $arg{partial},
25             ), $class
26             or return;
27            
28             $self->configure (\%arg)
29             }
30              
31             sub configure {
32             my ($self, $arg) = @_;
33            
34             $arg->{LocalHost} ||= delete $arg->{LocalAddr};
35             $arg->{PeerHost} ||= delete $arg->{PeerAddr};
36            
37             ${*$self}{io_socket_timeout} = $arg->{Timeout};
38            
39             my @sa;
40             eval {
41             if ($arg->{ReuseAddr}) {
42             $self->setsockopt (SOL_SOCKET, SO_REUSEADDR, 1)
43             or croak "setsockopt(SO_REUSEADDR): $!";
44             }
45            
46             if ($arg->{ReusePort}) {
47             $self->setsockopt (SOL_SOCKET, SO_REUSEPORT, 1)
48             or croak "setsockopt(SO_REUSEPORT): $!";
49             }
50            
51             if ($arg->{Broadcast}) {
52             $self->setsockopt (SOL_SOCKET, SO_BROADCAST, 1)
53             or croak "setsockopt(SO_BROADCAST): $!";
54             }
55            
56             if ($arg->{SO_RCVBUF}) {
57             $self->setsockopt (SOL_SOCKET, SO_RCVBUF, $arg->{SO_RCVBUF})
58             or croak "setsockopt(SO_RCVBUF): $!";
59             }
60            
61             if ($arg->{SO_SNDBUF}) {
62             $self->setsockopt (SOL_SOCKET, SO_SNDBUF, $arg->{SO_SNDBUF})
63             or croak "setsockopt(SO_SNDBUF): $!";
64             }
65            
66             if ($arg->{LocalPort} || $arg->{LocalHost}) {
67             @sa = _sa($arg->{LocalHost} || "0.0.0.0", $arg->{LocalPort} || 0, $arg->{Proto});
68             $self->bind ($sa[0])
69             or croak "bind($arg->{LocalHost}:$arg->{LocalPort}): $!";
70             }
71            
72             if ($arg->{PeerHost}) {
73             @sa = _sa ($arg->{PeerHost}, $arg->{PeerPort}, $arg->{Proto});
74             }
75             };
76             if (my $err = $@) {
77             $err =~ s/\s+at\s+.+?line\s+\d+\.//;
78             $@ = $err;
79             return;
80             }
81            
82             if ($arg->{PeerHost}) {
83             for (@sa) {
84             $! = 0;
85             if ($self->connect ($_)) {
86             next unless writable $self;
87             $! = unpack "i", $self->getsockopt (SOL_SOCKET, SO_ERROR);
88             }
89            
90             $! or return $self;
91            
92             $!{ECONNREFUSED} or $!{ENETUNREACH} or $!{ETIMEDOUT} or $!{EHOSTUNREACH}
93             or last;
94             }
95            
96             return;
97             }
98            
99             if (exists $arg->{Listen}) {
100             $self->listen ($arg->{Listen})
101             or return;
102             }
103            
104             $self
105             }
106              
107             1;
108              
109             __END__