File Coverage

blib/lib/Protocol/Database/PostgreSQL/Backend/RowDescription.pm
Criterion Covered Total %
statement 12 25 48.0
branch 0 2 0.0
condition n/a
subroutine 4 6 66.6
pod 1 2 50.0
total 17 35 48.5


line stmt bran cond sub pod time code
1             package Protocol::Database::PostgreSQL::Backend::RowDescription;
2              
3 1     1   12 use strict;
  1         2  
  1         31  
4 1     1   5 use warnings;
  1         2  
  1         43  
5              
6             our $VERSION = '1.005'; # VERSION
7              
8 1     1   6 use parent qw(Protocol::Database::PostgreSQL::Backend);
  1         2  
  1         5  
9              
10             =head1 NAME
11              
12             Protocol::Database::PostgreSQL::Backend::RowDescription
13              
14             =head1 DESCRIPTION
15              
16             =cut
17              
18 1     1   60 use Log::Any qw($log);
  1         3  
  1         4  
19              
20 0     0 0   sub description { shift->{description} }
21              
22             sub new_from_message {
23 0     0 1   my ($class, $msg) = @_;
24 0           my (undef, undef, $count) = unpack('C1N1n1', $msg);
25 0           substr $msg, 0, 7, '';
26 0           my @desc;
27 0           foreach my $id (0..$count-1) {
28 0           my ($name, $table_id, $field_id, $data_type, $data_size, $type_modifier, $format_code) = unpack('Z*N1n1N1n1N1n1', $msg);
29 0           my %data = (
30             name => $name,
31             table_id => $table_id,
32             field_id => $field_id,
33             data_type => $data_type,
34             data_size => $data_size,
35             type_modifier => $type_modifier,
36             format_code => $format_code
37             );
38 0 0         if($log->is_debug) {
39 0           $log->tracef('%s => %s', $_, $data{$_}) for sort keys %data;
40             }
41 0           push @desc, \%data;
42 0           substr $msg, 0, 19 + length($name), '';
43             }
44 0           return $class->new(
45             description => \@desc
46             );
47             }
48              
49             1;
50              
51             =head1 AUTHOR
52              
53             Tom Molesworth
54              
55             =head1 LICENSE
56              
57             Copyright Tom Molesworth 2010-2019. Licensed under the same terms as Perl itself.
58