File Coverage

blib/lib/Object/Remote/ReadChannel.pm
Criterion Covered Total %
statement 27 32 84.3
branch 4 6 66.6
condition 4 6 66.6
subroutine 6 11 54.5
pod 0 1 0.0
total 41 56 73.2


line stmt bran cond sub pod time code
1             package Object::Remote::ReadChannel;
2              
3 12     12   10499 use Scalar::Util qw(weaken openhandle);
  12         32  
  12         1836  
4 12     12   101 use Object::Remote::Logging qw(:log :dlog router );
  12         36  
  12         263  
5 12     12   100 use Moo;
  12         37  
  12         168  
6              
7 12     12   10343 BEGIN { router()->exclude_forwarding }
8              
9             has fh => (
10             is => 'ro', required => 1,
11             trigger => sub {
12             my ($self, $fh) = @_;
13             weaken($self);
14             log_trace { "Watching filehandle via trigger on 'fh' attribute in Object::Remote::ReadChannel" };
15             Object::Remote->current_loop
16             ->watch_io(
17             handle => $fh,
18             on_read_ready => sub { $self->_receive_data_from($fh) }
19             );
20             },
21             );
22              
23             has on_close_call => (
24             is => 'rw', default => sub { sub {} },
25             );
26              
27             has on_line_call => (is => 'rw');
28              
29             has _receive_data_buffer => (is => 'ro', default => sub { my $x = ''; \$x });
30              
31             sub _receive_data_from {
32 193     193   607 my ($self, $fh) = @_;
33 193     0   2177 Dlog_trace { "Preparing to read data from $_" } $fh;
  0         0  
34 193         4388 my $rb = $self->_receive_data_buffer;
35 193         4846 my $len = sysread($fh, $$rb, 32768, length($$rb));
36 193 50       1021 my $err = defined($len) ? 'eof' : ": $!";
37 193 100 66     1553 if (defined($len) and $len > 0) {
38 192     0   1966 log_trace { "Read $len bytes of data" };
  0         0  
39 192   66     5715 while (my $cb = $self->on_line_call and $$rb =~ s/^(.*)\n//) {
40 192         1515 $cb->(my $line = $1);
41             }
42             } else {
43 1     0   11 log_trace { "Got EOF or error, this read channel is done" };
  0         0  
44 1         24 Object::Remote->current_loop
45             ->unwatch_io(
46             handle => $self->fh,
47             on_read_ready => 1
48             );
49 1     0   8 log_trace { "Invoking on_close_call() for dead read channel" };
  0         0  
50 1         24 $self->on_close_call->($err);
51             }
52             }
53              
54             sub DEMOLISH {
55 1     1 0 1425 my ($self, $gd) = @_;
56 1 50       5 return if $gd;
57 1     0   9 log_trace { "read channel is being demolished" };
  0         0  
58              
59 1         19 Object::Remote->current_loop
60             ->unwatch_io(
61             handle => $self->fh,
62             on_read_ready => 1
63             );
64             }
65              
66             1;