File Coverage

blib/lib/IO/Framed/Read.pm
Criterion Covered Total %
statement 32 35 91.4
branch 8 12 66.6
condition 2 3 66.6
subroutine 7 8 87.5
pod 0 4 0.0
total 49 62 79.0


line stmt bran cond sub pod time code
1             package IO::Framed::Read;
2              
3 1     1   55139 use strict;
  1         3  
  1         24  
4 1     1   4 use warnings;
  1         2  
  1         38  
5              
6 1     1   311 use IO::SigGuard ();
  1         1675  
  1         17  
7              
8 1     1   278 use IO::Framed::X ();
  1         2  
  1         289  
9              
10             sub new {
11 2     2 0 1204 my ( $class, $in_fh, $initial_buffer ) = @_;
12              
13 2 50       6 if ( !defined $initial_buffer ) {
14 2         3 $initial_buffer = q<>;
15             }
16              
17 2         7 my $self = {
18             _in_fh => $in_fh,
19             _read_buffer => $initial_buffer,
20             _bytes_to_read => 0,
21             };
22              
23 2         7 return bless $self, $class;
24             }
25              
26 0     0 0 0 sub get_read_fh { return $_[0]->{'_in_fh'} }
27              
28             #----------------------------------------------------------------------
29             # IO subclass interface
30              
31             sub allow_empty_read {
32 1     1 0 471 my ($self) = @_;
33 1         2 $self->{'_ALLOW_EMPTY_READ'} = 1;
34 1         4 return $self;
35             }
36              
37             my $buf_len;
38              
39             #We assume here that whatever read may be incomplete at first
40             #will eventually be repeated so that we can complete it. e.g.:
41             #
42             # - read 4 bytes, receive 1, cache it - return q<>
43             # - select()
44             # - read 4 bytes again; since we already have 1 byte, only read 3
45             # … and now we get the remaining 3, so return the buffer.
46             #
47             sub read {
48 7     7 0 951 my ( $self, $bytes ) = @_;
49              
50 7 50       17 die "I refuse to read zero!" if !$bytes;
51              
52 7 100       18 if ( $buf_len = length $self->{'_read_buffer'} ) {
53 1 50       4 if ( $buf_len + $self->{'_bytes_to_read'} != $bytes ) {
54 0         0 my $should_be = $buf_len + $self->{'_bytes_to_read'};
55 0         0 die "Continuation: should want “$should_be” bytes, not $bytes!";
56             }
57             }
58              
59 7 50       12 if ( $bytes > $buf_len ) {
60 7         10 $bytes -= $buf_len;
61              
62 7         18 local $!;
63              
64 7   66     17 $bytes -= IO::SigGuard::sysread( $self->{'_in_fh'}, $self->{'_read_buffer'}, $bytes, $buf_len ) || do {
65             if ($!) {
66             if ( !$!{'EAGAIN'} && !$!{'EWOULDBLOCK'}) {
67             die IO::Framed::X->create( 'ReadError', $! );
68             }
69             }
70             elsif ($self->{'_ALLOW_EMPTY_READ'}) {
71             return q<>;
72             }
73             else {
74             die IO::Framed::X->create('EmptyRead');
75             }
76             };
77             }
78              
79 4         51 $self->{'_bytes_to_read'} = $bytes;
80              
81 4 100       7 if ($bytes) {
82 2         9 return undef;
83             }
84              
85 2         7 return substr( $self->{'_read_buffer'}, 0, length($self->{'_read_buffer'}), q<> );
86             }
87              
88             #----------------------------------------------------------------------
89              
90             1;