File Coverage

blib/lib/DBGp/Client/Stream.pm
Criterion Covered Total %
statement 6 25 24.0
branch 0 10 0.0
condition n/a
subroutine 2 5 40.0
pod 0 3 0.0
total 8 43 18.6


line stmt bran cond sub pod time code
1             package DBGp::Client::Stream;
2              
3 2     2   1001 use strict;
  2         3  
  2         42  
4 2     2   4 use warnings;
  2         3  
  2         476  
5              
6             sub new {
7 0     0 0   my ($class, %args) = @_;
8             my $self = bless {
9             socket => $args{socket},
10 0           buffer => '',
11             }, $class;
12              
13 0           return $self;
14             }
15              
16             sub get_line {
17 0     0 0   my ($self) = @_;
18 0           my $buffer = \$self->{buffer};
19              
20 0           my $len_end = index($$buffer, "\x00");
21 0           while ($len_end == -1) {
22             return undef
23 0 0         if read($self->{socket}, $$buffer, 2, length($$buffer)) == 0;
24              
25 0           $len_end = index($$buffer, "\x00");
26             }
27              
28 0           my $len = substr $$buffer, 0, $len_end;
29 0           substr $$buffer, 0, $len_end + 1, '';
30              
31 0 0         if (length($$buffer) < $len + 1) {
32             return undef
33 0 0         if read($self->{socket}, $$buffer, $len + 1 - length($$buffer), length($$buffer)) == 0;
34             }
35              
36 0 0         die "Short read"
37             if length($$buffer) < $len + 1;
38 0 0         die "Packat is not null-terminated"
39             unless substr($$buffer, $len, 1, '') eq "\x00";
40              
41 0           return substr $$buffer, 0, $len, '';
42             }
43              
44             sub put_line {
45 0     0 0   my ($self, @items) = @_;
46 0           my $cmd = join(" ", @items);
47              
48 0           syswrite $self->{socket}, $cmd . "\x00";
49             }
50              
51             1;