File Coverage

lib/IOMux/Handler/Read.pm
Criterion Covered Total %
statement 67 78 85.9
branch 14 26 53.8
condition 2 8 25.0
subroutine 17 18 94.4
pod 7 8 87.5
total 107 138 77.5


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;