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

package Protocol::Database::PostgreSQL::Backend::RowDescription;

use strict;
use warnings;

our $VERSION = '1.005'; # VERSION

use parent qw(Protocol::Database::PostgreSQL::Backend);

=head1 NAME

Protocol::Database::PostgreSQL::Backend::RowDescription

=head1 DESCRIPTION

=cut

use Log::Any qw($log);

sub description { shift->{description} }

sub new_from_message {
    my ($class, $msg) = @_;
    my (undef, undef, $count) = unpack('C1N1n1', $msg);
    substr $msg, 0, 7, '';
    my @desc;
    foreach my $id (0..$count-1) {
        my ($name, $table_id, $field_id, $data_type, $data_size, $type_modifier, $format_code) = unpack('Z*N1n1N1n1N1n1', $msg);
        my %data = (
            name          => $name,
            table_id      => $table_id,
            field_id      => $field_id,
            data_type     => $data_type,
            data_size     => $data_size,
            type_modifier => $type_modifier,
            format_code   => $format_code
        );
        if($log->is_debug) {
            $log->tracef('%s => %s', $_, $data{$_}) for sort keys %data;
        }
        push @desc, \%data;
        substr $msg, 0, 19 + length($name), '';
    }
    return $class->new(
        description => \@desc
    );
}

1;

=head1 AUTHOR

Tom Molesworth

=head1 LICENSE

Copyright Tom Molesworth 2010-2019. Licensed under the same terms as Perl itself.