| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# Copyrights 2011 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 1.07. |
|
5
|
7
|
|
|
7
|
|
1159
|
use warnings; |
|
|
7
|
|
|
|
|
17
|
|
|
|
7
|
|
|
|
|
240
|
|
|
6
|
7
|
|
|
7
|
|
40
|
use strict; |
|
|
7
|
|
|
|
|
14
|
|
|
|
7
|
|
|
|
|
353
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package IOMux::Handler::Read; |
|
9
|
7
|
|
|
7
|
|
35
|
use vars '$VERSION'; |
|
|
7
|
|
|
|
|
15
|
|
|
|
7
|
|
|
|
|
364
|
|
|
10
|
|
|
|
|
|
|
$VERSION = '0.12'; |
|
11
|
|
|
|
|
|
|
|
|
12
|
7
|
|
|
7
|
|
79
|
use base 'IOMux::Handler'; |
|
|
7
|
|
|
|
|
13
|
|
|
|
7
|
|
|
|
|
1815
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
7
|
|
|
7
|
|
49
|
use Log::Report 'iomux'; |
|
|
7
|
|
|
|
|
12
|
|
|
|
7
|
|
|
|
|
112
|
|
|
15
|
7
|
|
|
7
|
|
3221
|
use Fcntl; |
|
|
7
|
|
|
|
|
19
|
|
|
|
7
|
|
|
|
|
3196
|
|
|
16
|
7
|
|
|
7
|
|
188
|
use POSIX 'errno_h'; |
|
|
7
|
|
|
|
|
14
|
|
|
|
7
|
|
|
|
|
100
|
|
|
17
|
7
|
|
|
7
|
|
4538
|
use File::Basename 'basename'; |
|
|
7
|
|
|
|
|
15
|
|
|
|
7
|
|
|
|
|
7175
|
|
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub init($) |
|
21
|
8
|
|
|
8
|
0
|
28
|
{ my ($self, $args) = @_; |
|
22
|
8
|
|
|
|
|
131
|
$self->SUPER::init($args); |
|
23
|
8
|
|
100
|
|
|
96
|
$self->{IMHR_read_size} = $args->{read_size} || 32768; |
|
24
|
8
|
|
|
|
|
39
|
$self->{IMHR_inbuf} = ''; |
|
25
|
8
|
|
|
|
|
27
|
$self; |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
#------------------- |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub readSize(;$) |
|
31
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
|
32
|
0
|
0
|
|
|
|
0
|
@_ ? $self->{IMHR_read_size} = shift : $self->{IMHR_read_size}; |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
#----------------------- |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub readline($) |
|
38
|
8
|
|
|
8
|
1
|
10539
|
{ my ($self, $cb) = @_; |
|
39
|
8
|
100
|
|
|
|
54
|
if($self->{IMHR_inbuf} =~ s/^([^\r\n]*)(?:\r?\n)//) |
|
40
|
4
|
|
|
|
|
26
|
{ return $cb->($self, "$1\n"); |
|
41
|
|
|
|
|
|
|
} |
|
42
|
4
|
50
|
|
|
|
18
|
if($self->{IMHR_eof}) |
|
43
|
|
|
|
|
|
|
{ # eof already before readline and no trailing nl |
|
44
|
0
|
|
|
|
|
0
|
my $line = $self->{IMHR_inbuf}; |
|
45
|
0
|
|
|
|
|
0
|
$self->{IMHR_inbuf} = ''; |
|
46
|
0
|
|
|
|
|
0
|
return $cb->($self, $line); |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
$self->{IMHR_read_more} = sub |
|
50
|
4
|
|
|
4
|
|
8
|
{ my ($in, $eof) = @_; |
|
51
|
4
|
100
|
|
|
|
16
|
if($eof) |
|
52
|
2
|
|
|
|
|
7
|
{ delete $self->{IMHR_read_more}; |
|
53
|
2
|
|
|
|
|
5
|
my $line = $self->{IMHR_inbuf}; |
|
54
|
2
|
|
|
|
|
5
|
$self->{IMHR_inbuf} = ''; |
|
55
|
2
|
|
|
|
|
10
|
return $cb->($self, $line); |
|
56
|
|
|
|
|
|
|
} |
|
57
|
2
|
50
|
|
|
|
5
|
${$_[0]} =~ s/^([^\r\n]*)\r?\n// |
|
|
2
|
|
|
|
|
26
|
|
|
58
|
|
|
|
|
|
|
or return; |
|
59
|
2
|
|
|
|
|
7
|
delete $self->{IMHR_read_more}; |
|
60
|
2
|
|
|
|
|
15
|
$cb->($self, "$1\n"); |
|
61
|
4
|
|
|
|
|
156
|
}; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub slurp($) |
|
66
|
4
|
|
|
4
|
1
|
1387
|
{ my ($self, $cb) = @_; |
|
67
|
|
|
|
|
|
|
|
|
68
|
4
|
50
|
|
|
|
25
|
if($self->{IMHR_eof}) # eof already before readline |
|
69
|
0
|
0
|
|
|
|
0
|
{ my $in = $self->{IMHR_inbuf} or return $cb->($self, \''); |
|
70
|
0
|
|
|
|
|
0
|
my $bytes = $$in; # does copy the bytes. Cannot help it easily |
|
71
|
0
|
|
|
|
|
0
|
$$in = ''; |
|
72
|
0
|
|
|
|
|
0
|
return $cb->($self, \$bytes); |
|
73
|
|
|
|
|
|
|
} |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
$self->{IMHR_read_more} = sub |
|
76
|
8
|
|
|
8
|
|
15
|
{ my ($in, $eof) = @_; |
|
77
|
8
|
100
|
|
|
|
54
|
$eof or return; |
|
78
|
4
|
|
|
|
|
12
|
delete $self->{IMHR_read_more}; |
|
79
|
4
|
|
|
|
|
11
|
my $bytes = $$in; # does copy the bytes |
|
80
|
4
|
|
|
|
|
9
|
$$in = ''; |
|
81
|
4
|
|
|
|
|
26
|
$cb->($self, \$bytes); |
|
82
|
4
|
|
|
|
|
217
|
}; |
|
83
|
|
|
|
|
|
|
} |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
#------------------------- |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub mux_init($) |
|
88
|
6
|
|
|
6
|
1
|
77
|
{ my ($self, $mux) = @_; |
|
89
|
6
|
|
|
|
|
74
|
$self->SUPER::mux_init($mux); |
|
90
|
6
|
|
|
|
|
276
|
$self->fdset(1, 1, 0, 0); |
|
91
|
|
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub mux_read_flagged($) |
|
94
|
12
|
|
|
12
|
1
|
30
|
{ my $self = shift; |
|
95
|
|
|
|
|
|
|
|
|
96
|
12
|
|
|
|
|
60
|
my $bytes_read |
|
97
|
|
|
|
|
|
|
= sysread $self->fh, $self->{IMHR_inbuf}, $self->{IMHR_read_size} |
|
98
|
|
|
|
|
|
|
, length($self->{IMHR_inbuf}); |
|
99
|
|
|
|
|
|
|
|
|
100
|
12
|
100
|
0
|
|
|
53
|
if($bytes_read) # > 0 |
|
|
|
50
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
101
|
6
|
|
|
|
|
60
|
{ $self->mux_input(\$self->{IMHR_inbuf}); |
|
102
|
|
|
|
|
|
|
} |
|
103
|
|
|
|
|
|
|
elsif(defined $bytes_read) # == 0 |
|
104
|
6
|
|
|
|
|
34
|
{ $self->fdset(0, 1, 0, 0); |
|
105
|
6
|
|
|
|
|
165
|
$self->mux_eof(\$self->{IMHR_inbuf}); |
|
106
|
|
|
|
|
|
|
} |
|
107
|
|
|
|
|
|
|
elsif($!==EINTR || $!==EAGAIN || $!==EWOULDBLOCK) |
|
108
|
|
|
|
|
|
|
{ # a bit unexpected, but ok |
|
109
|
|
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
else |
|
111
|
0
|
|
|
|
|
0
|
{ warning __x"read from {name} closed unexpectedly: {err}" |
|
112
|
|
|
|
|
|
|
, name => $self->name, err => $!; |
|
113
|
0
|
|
|
|
|
0
|
$self->close; |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
} |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub mux_input($) |
|
119
|
6
|
|
|
6
|
1
|
117
|
{ my ($self, $inbuf) = @_; |
|
120
|
6
|
50
|
|
|
|
43
|
return $self->{IMHR_read_more}->($inbuf, 0) |
|
121
|
|
|
|
|
|
|
if $self->{IMHR_read_more}; |
|
122
|
|
|
|
|
|
|
} |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub mux_eof($) |
|
126
|
6
|
|
|
6
|
1
|
26
|
{ my ($self, $inbuf) = @_; |
|
127
|
6
|
|
|
|
|
16
|
$self->{IMHR_eof} = 1; |
|
128
|
6
|
50
|
|
|
|
33
|
$self->{IMHR_read_more}->($inbuf, 1) |
|
129
|
|
|
|
|
|
|
if $self->{IMHR_read_more}; |
|
130
|
|
|
|
|
|
|
} |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
1; |