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; |