File Coverage

blib/lib/Tak/JSONChannel.pm
Criterion Covered Total %
statement 15 54 27.7
branch 0 14 0.0
condition 0 4 0.0
subroutine 5 14 35.7
pod 0 3 0.0
total 20 89 22.4


line stmt bran cond sub pod time code
1             package Tak::JSONChannel;
2              
3 1     1   5 use JSON::PP qw(encode_json decode_json);
  1         3  
  1         63  
4 1     1   4 use IO::Handle;
  1         2  
  1         30  
5 1     1   4 use Scalar::Util qw(weaken);
  1         2  
  1         100  
6 1     1   5 use Log::Contextual qw(:log);
  1         1  
  1         6  
7 1     1   1472 use Moo;
  1         2  
  1         5  
8              
9             has read_fh => (is => 'ro', required => 1);
10             has write_fh => (is => 'ro', required => 1);
11              
12             has _read_buf => (is => 'ro', default => sub { my $x = ''; \$x });
13              
14 0     0 0   sub BUILD { shift->write_fh->autoflush(1); }
15              
16             sub read_messages {
17 0     0 0   my ($self, $cb) = @_;
18 0           my $rb = $self->_read_buf;
19 0 0         if (sysread($self->read_fh, $$rb, 1024, length($$rb)) > 0) {
20 0           while ($$rb =~ s/^(.*)\n//) {
21 0           my $line = $1;
22 0     0     log_trace { "Received $line" };
  0            
23 0 0         if (my $unpacked = $self->_unpack_line($line)) {
24 0           $cb->(@$unpacked);
25             }
26             }
27             } else {
28 0     0     log_trace { "Closing" };
  0            
29 0           $cb->('close', 'channel');
30             }
31             }
32              
33             sub _unpack_line {
34 0     0     my ($self, $line) = @_;
35 0           my $data = eval { decode_json($line) };
  0            
36 0 0         unless ($data) {
37 0   0       $self->write_message(mistake => invalid_json => $@||'No data and no exception');
38 0           return;
39             }
40 0 0         unless (ref($data) eq 'ARRAY') {
41 0           $self->write_message(mistake => message_format => "Not an ARRAY");
42 0           return;
43             }
44 0 0         unless (@$data > 0) {
45 0           $self->write_message(mistake => message_format => "Empty request array");
46 0           return;
47             }
48 0           $data;
49             }
50              
51             sub write_message {
52 0     0 0   my ($self, @msg) = @_;
53 0           my $json = eval { encode_json(\@msg) };
  0            
54 0 0         unless ($json) {
55 0   0       $self->_raw_write_message(
56             encode_json(
57             [ failure => invalid_message => $@||'No data and no exception' ]
58             )
59             );
60 0           return;
61             }
62 0     0     log_trace { "Sending: $json" };
  0            
63 0           $self->_raw_write_message($json);
64             }
65              
66             sub _raw_write_message {
67 0     0     my ($self, $raw) = @_;
68             #warn "Sending: ${raw}\n";
69 0           print { $self->write_fh } $raw."\n"
70 0 0   0     or log_error { "Error writing: $!" };
  0            
71             }
72              
73             1;