File Coverage

blib/lib/Protocol/Database/PostgreSQL/Backend/DataRow.pm
Criterion Covered Total %
statement 12 24 50.0
branch 0 2 0.0
condition n/a
subroutine 4 7 57.1
pod 1 3 33.3
total 17 36 47.2


line stmt bran cond sub pod time code
1             package Protocol::Database::PostgreSQL::Backend::DataRow;
2              
3 1     1   14 use strict;
  1         2  
  1         32  
4 1     1   8 use warnings;
  1         2  
  1         49  
5              
6             our $VERSION = '1.005'; # VERSION
7              
8 1     1   5 use parent qw(Protocol::Database::PostgreSQL::Backend);
  1         2  
  1         10  
9              
10             =head1 NAME
11              
12             Protocol::Database::PostgreSQL::Backend::DataRow
13              
14             =head1 DESCRIPTION
15              
16             =cut
17              
18 1     1   64 use Log::Any qw($log);
  1         2  
  1         19  
19              
20 0     0 0   sub type { 'data_row' }
21              
22 0     0 0   sub fields { shift->{fields}->@* }
23              
24             sub new_from_message {
25 0     0 1   my ($class, $msg) = @_;
26 0           my (undef, undef, $count) = unpack('C1N1n1', $msg);
27 0           substr $msg, 0, 7, '';
28 0           my @fields;
29 0           foreach my $idx (0..$count - 1) {
30 0           my ($size) = unpack('N1', substr $msg, 0, 4, '');
31 0 0         if($size == 0xFFFFFFFF) {
32 0           push @fields, undef;
33             } else {
34 0           push @fields, substr $msg, 0, $size, '';
35             }
36             }
37 0           return $class->new(
38             fields => \@fields
39             )
40             }
41              
42             1;
43              
44             =head1 AUTHOR
45              
46             Tom Molesworth
47              
48             =head1 LICENSE
49              
50             Copyright Tom Molesworth 2010-2019. Licensed under the same terms as Perl itself.
51