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   9604 use Scalar::Util qw(weaken openhandle);
  12         144  
  12         1967  
4 12     12   75 use Object::Remote::Logging qw(:log :dlog router );
  12         22  
  12         250  
5 12     12   92 use Moo;
  12         29  
  12         270  
6              
7 12     12   6820 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   443 my ($self, $fh) = @_;
33 193     0   1151 Dlog_trace { "Preparing to read data from $_" } $fh;
  0         0  
34 193         2411 my $rb = $self->_receive_data_buffer;
35 193         3554 my $len = sysread($fh, $$rb, 32768, length($$rb));
36 193 50       787 my $err = defined($len) ? 'eof' : ": $!";
37 193 100 66     1044 if (defined($len) and $len > 0) {
38 192     0   1463 log_trace { "Read $len bytes of data" };
  0         0  
39 192   66     3293 while (my $cb = $self->on_line_call and $$rb =~ s/^(.*)\n//) {
40 192         925 $cb->(my $line = $1);
41             }
42             } else {
43 1     0   18 log_trace { "Got EOF or error, this read channel is done" };
  0         0  
44 1         16 Object::Remote->current_loop
45             ->unwatch_io(
46             handle => $self->fh,
47             on_read_ready => 1
48             );
49 1     0   5 log_trace { "Invoking on_close_call() for dead read channel" };
  0         0  
50 1         16 $self->on_close_call->($err);
51             }
52             }
53              
54             sub DEMOLISH {
55 1     1 0 1016 my ($self, $gd) = @_;
56 1 50       4 return if $gd;
57 1     0   6 log_trace { "read channel is being demolished" };
  0         0  
58              
59 1         14 Object::Remote->current_loop
60             ->unwatch_io(
61             handle => $self->fh,
62             on_read_ready => 1
63             );
64             }
65              
66             1;