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-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 7     7   1447 use warnings;
  7         14  
  7         224  
6 7     7   38 use strict;
  7         12  
  7         258  
7              
8             package IOMux::Handler::Read;
9 7     7   36 use vars '$VERSION';
  7         15  
  7         360  
10             $VERSION = '1.00';
11              
12 7     7   39 use base 'IOMux::Handler';
  7         15  
  7         1244  
13              
14 7     7   42 use Log::Report 'iomux';
  7         11  
  7         71  
15 7     7   2247 use Fcntl;
  7         18  
  7         2609  
16 7     7   38 use POSIX 'errno_h';
  7         12  
  7         58  
17 7     7   3633 use File::Basename 'basename';
  7         12  
  7         6173  
18              
19              
20             sub init($)
21 8     8 0 18 { my ($self, $args) = @_;
22 8         84 $self->SUPER::init($args);
23 8   100     65 $self->{IMHR_read_size} = $args->{read_size} || 32768;
24 8         31 $self->{IMHR_inbuf} = '';
25 8         22 $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 3575 { my ($self, $cb) = @_;
39 8 100       42 if($self->{IMHR_inbuf} =~ s/^([^\r\n]*)(?:\r?\n)//)
40 4         20 { return $cb->($self, "$1\n");
41             }
42 4 50       14 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   6 { my ($in, $eof) = @_;
51 4 100       13 if($eof)
52 2         6 { delete $self->{IMHR_read_more};
53 2         5 my $line = $self->{IMHR_inbuf};
54 2         5 $self->{IMHR_inbuf} = '';
55 2         8 return $cb->($self, $line);
56             }
57 2 50       4 ${$_[0]} =~ s/^([^\r\n]*)\r?\n//
  2         16  
58             or return;
59 2         7 delete $self->{IMHR_read_more};
60 2         12 $cb->($self, "$1\n");
61 4         123 };
62             }
63              
64              
65             sub slurp($)
66 4     4 1 1076 { my ($self, $cb) = @_;
67              
68 4 50       40 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   28 { my ($in, $eof) = @_;
77 8 100       42 $eof or return;
78 4         9 delete $self->{IMHR_read_more};
79 4         11 my $bytes = $$in; # does copy the bytes
80 4         8 $$in = '';
81 4         22 $cb->($self, \$bytes);
82 4         261 };
83             }
84              
85             #-------------------------
86              
87             sub muxInit($)
88 6     6 1 56 { my ($self, $mux) = @_;
89 6         54 $self->SUPER::muxInit($mux);
90 6         200 $self->fdset(1, 1, 0, 0);
91             }
92              
93             sub muxReadFlagged($)
94 12     12 1 23 { my $self = shift;
95              
96             my $bytes_read
97             = sysread $self->fh, $self->{IMHR_inbuf}, $self->{IMHR_read_size}
98 12         44 , length($self->{IMHR_inbuf});
99              
100 12 100 0     55 if($bytes_read) # > 0
    50 0        
    0          
101 6         42 { $self->muxInput(\$self->{IMHR_inbuf});
102             }
103             elsif(defined $bytes_read) # == 0
104 6         25 { $self->fdset(0, 1, 0, 0);
105 6         143 $self->muxEOF(\$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 muxInput($)
119 6     6 1 13 { my ($self, $inbuf) = @_;
120             return $self->{IMHR_read_more}->($inbuf, 0)
121 6 50       40 if $self->{IMHR_read_more};
122             }
123              
124              
125             sub muxEOF($)
126 6     6 1 12 { my ($self, $inbuf) = @_;
127 6         19 $self->{IMHR_eof} = 1;
128             $self->{IMHR_read_more}->($inbuf, 1)
129 6 50       33 if $self->{IMHR_read_more};
130             }
131              
132             1;