line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyrights 2011-2015 by [Mark Overmeer]. |
2
|
|
|
|
|
|
|
# For other contributors see ChangeLog. |
3
|
|
|
|
|
|
|
# See the manual pages for details on the licensing terms. |
4
|
|
|
|
|
|
|
# Pod stripped from pm file by OODoc 2.02. |
5
|
8
|
|
|
8
|
|
15197
|
use warnings; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
215
|
|
6
|
8
|
|
|
8
|
|
37
|
use strict; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
241
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package IOMux::Handler; |
9
|
8
|
|
|
8
|
|
49
|
use vars '$VERSION'; |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
392
|
|
10
|
|
|
|
|
|
|
$VERSION = '1.00'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
8
|
|
|
8
|
|
825
|
use Log::Report 'iomux'; |
|
8
|
|
|
|
|
149153
|
|
|
8
|
|
|
|
|
52
|
|
14
|
|
|
|
|
|
|
|
15
|
8
|
|
|
8
|
|
2146
|
use Scalar::Util 'weaken'; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
425
|
|
16
|
8
|
|
|
8
|
|
7330
|
use Time::HiRes 'time'; |
|
8
|
|
|
|
|
19617
|
|
|
8
|
|
|
|
|
38
|
|
17
|
8
|
|
|
8
|
|
8320
|
use Socket; |
|
8
|
|
|
|
|
33604
|
|
|
8
|
|
|
|
|
5571
|
|
18
|
8
|
|
|
8
|
|
63
|
use Fcntl; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
12109
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $start_time = time; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
15
|
|
|
15
|
1
|
6557
|
sub new(@) {my $class = shift; (bless {}, $class)->init( {@_} ) } |
|
15
|
|
|
|
|
103
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub init($) |
26
|
16
|
|
|
16
|
0
|
47
|
{ my ($self, $args) = @_; |
27
|
16
|
50
|
|
|
|
116
|
return $self if $self->{IH_name}; # already initialized |
28
|
|
|
|
|
|
|
|
29
|
16
|
|
33
|
|
|
146
|
my $name = $self->{IH_name} = $args->{name} || "$self"; |
30
|
16
|
100
|
|
|
|
124
|
if(my $fh = $self->{IH_fh} = $args->{fh}) |
31
|
15
|
|
|
|
|
460
|
{ $self->{IH_fileno} = $fh->fileno; |
32
|
15
|
|
|
|
|
181
|
$self->{IH_uses_ssl} = UNIVERSAL::isa($fh, 'IO::Socket::SSL'); |
33
|
|
|
|
|
|
|
} |
34
|
16
|
|
|
|
|
49
|
$self; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
|
38
|
0
|
|
|
0
|
1
|
0
|
sub open() {panic} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
#------------------------- |
41
|
|
|
|
|
|
|
|
42
|
1
|
|
|
1
|
1
|
16
|
sub name() {shift->{IH_name}} |
43
|
0
|
|
|
0
|
1
|
0
|
sub mux() {shift->{IH_mux}} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
|
46
|
2
|
|
|
2
|
1
|
5
|
sub fileno() {shift->{IH_fileno}} |
47
|
43
|
|
|
43
|
1
|
543
|
sub fh() {shift->{IH_fh}} |
48
|
0
|
|
|
0
|
1
|
0
|
sub usesSSL(){shift->{IH_uses_ssl}} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#----------------------- |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub timeout(;$) |
53
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
54
|
0
|
0
|
|
|
|
0
|
@_ or return $self->{IH_timeout}; |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
0
|
my $old = $self->{IH_timeout}; |
57
|
0
|
|
|
|
|
0
|
my $after = shift; |
58
|
0
|
0
|
|
|
|
0
|
my $when = !$after ? undef |
|
|
0
|
|
|
|
|
|
59
|
|
|
|
|
|
|
: $after > $start_time ? $after |
60
|
|
|
|
|
|
|
: ($after + time); |
61
|
|
|
|
|
|
|
|
62
|
0
|
|
|
|
|
0
|
$self->{IH_mux}->changeTimeout($self->{IH_fileno}, $old, $when); |
63
|
0
|
|
|
|
|
0
|
$self->{IH_timeout} = $when; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub close(;$) |
68
|
16
|
|
|
16
|
1
|
1944
|
{ my ($self, $cb) = @_; |
69
|
16
|
100
|
|
|
|
59
|
if(my $fh = delete $self->{IH_fh}) |
70
|
13
|
50
|
|
|
|
48
|
{ if(my $mux = $self->{IH_mux}) |
71
|
13
|
|
|
|
|
63
|
{ $mux->remove($self->{IH_fileno}); |
72
|
|
|
|
|
|
|
} |
73
|
13
|
|
|
|
|
117
|
$fh->close; |
74
|
|
|
|
|
|
|
} |
75
|
16
|
|
|
|
|
229
|
local $!; |
76
|
16
|
100
|
|
|
|
113
|
$cb->($self) if $cb; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
#------------------------- |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub muxInit($;$) |
82
|
13
|
|
|
13
|
1
|
54
|
{ my ($self, $mux, $handler) = @_; |
83
|
|
|
|
|
|
|
|
84
|
13
|
|
|
|
|
59
|
$self->{IH_mux} = $mux; |
85
|
13
|
|
|
|
|
119
|
weaken($self->{IH_mux}); |
86
|
|
|
|
|
|
|
|
87
|
13
|
|
|
|
|
21
|
my $fileno = $self->{IH_fileno}; |
88
|
13
|
|
33
|
|
|
204
|
$mux->handler($fileno, $handler || $self); |
89
|
|
|
|
|
|
|
|
90
|
13
|
50
|
|
|
|
43
|
if(my $timeout = $self->{IH_timeout}) |
91
|
0
|
|
|
|
|
0
|
{ $mux->changeTimeout($fileno, undef, $timeout); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
13
|
|
|
|
|
165
|
trace "mux add #$fileno, $self->{IH_name}"; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub muxRemove() |
99
|
13
|
|
|
13
|
1
|
20
|
{ my $self = shift; |
100
|
13
|
|
|
|
|
28
|
delete $self->{IH_mux}; |
101
|
|
|
|
|
|
|
#use Carp 'cluck'; |
102
|
|
|
|
|
|
|
#cluck "REMOVE"; |
103
|
13
|
|
|
|
|
79
|
trace "mux remove #$self->{IH_fileno}, $self->{IH_name}"; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub muxTimeout() |
108
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
109
|
0
|
|
|
|
|
0
|
error __x"timeout set on {name} but not handled", name => $self->name; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
#---------------------- |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
#sub muxReadFlagged($) { panic "no input expected on ". shift->name } |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
#sub muxExceptFlagged($) { panic "exception arrived on ". shift->name } |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
#sub muxWriteFlagged($) { shift } # simply ignore write offers |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#------------------------- |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub show() |
127
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
128
|
0
|
|
|
|
|
0
|
my $name = $self->name; |
129
|
0
|
0
|
|
|
|
0
|
my $fh = $self->fh |
130
|
|
|
|
|
|
|
or return "fileno=".$self->fileno." is closed; name=$name"; |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
0
|
my $mode = 'unknown'; |
133
|
0
|
0
|
|
|
|
0
|
unless($^O eq 'Win32') |
134
|
0
|
0
|
|
|
|
0
|
{ my $flags = fcntl $fh, F_GETFL, 0 or fault "fcntl F_GETFL"; |
135
|
0
|
0
|
|
|
|
0
|
$mode = ($flags & O_WRONLY) ? 'w' |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
136
|
|
|
|
|
|
|
: ($flags & O_RDONLY) ? 'r' |
137
|
|
|
|
|
|
|
: ($flags & O_RDWR) ? 'rw' |
138
|
|
|
|
|
|
|
: 'p'; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
0
|
my @show = ("fileno=".$fh->fileno, "mode=$mode"); |
142
|
0
|
0
|
|
|
|
0
|
if(my $sockopts = getsockopt $fh, SOL_SOCKET, SO_TYPE) |
143
|
|
|
|
|
|
|
{ # socket |
144
|
0
|
|
|
|
|
0
|
my $type = unpack "i", $sockopts; |
145
|
0
|
0
|
|
|
|
0
|
my $kind = $type==SOCK_DGRAM ? 'UDP' : $type==SOCK_STREAM ? 'TCP' |
|
|
0
|
|
|
|
|
|
146
|
|
|
|
|
|
|
: 'unknown'; |
147
|
0
|
|
|
|
|
0
|
push @show, "sock=$kind"; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
0
|
join ", ", @show, "name=$name"; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub fdset($$$$) |
155
|
19
|
|
|
19
|
1
|
44
|
{ my $self = shift; |
156
|
19
|
|
|
|
|
124
|
$self->{IH_mux}->fdset($self->{IH_fileno}, @_); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub extractSocket($) |
161
|
0
|
|
|
0
|
1
|
|
{ my ($thing, $args) = @_; |
162
|
0
|
|
0
|
|
|
|
my $class = ref $thing || $thing; |
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
my $socket = delete $args->{socket}; |
165
|
0
|
0
|
|
|
|
|
return $socket if $socket; |
166
|
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
|
my @sockopts = (Blocking => 0); |
168
|
|
|
|
|
|
|
push @sockopts, $_ => $args->{$_} |
169
|
0
|
|
|
|
|
|
for grep /^[A-Z]/, keys %$args; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
@sockopts |
172
|
0
|
0
|
|
|
|
|
or error __x"pass socket or provide parameters to create one for {pkg}" |
173
|
|
|
|
|
|
|
, pkg => $class; |
174
|
|
|
|
|
|
|
|
175
|
0
|
|
|
|
|
|
my $ssl = delete $args->{use_ssl}; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# the extension will load these classes |
178
|
0
|
0
|
|
|
|
|
my $make = $ssl ? 'IO::Socket::SSL' : 'IO::Socket::INET'; |
179
|
0
|
0
|
|
|
|
|
$socket = $make->new(@sockopts) |
180
|
|
|
|
|
|
|
or fault __x"cannot create {pkg} socket", pkg => $class; |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
$socket; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
1; |