File Coverage

lib/Net/EGTS/SubRecord/Auth/ResultCode.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 24 24 100.0


line stmt bran cond sub pod time code
1 2     2   62637 use utf8;
  2         12  
  2         13  
2              
3             package Net::EGTS::SubRecord::Auth::ResultCode;
4 2     2   521 use Mouse;
  2         26767  
  2         11  
5             extends qw(Net::EGTS::SubRecord);
6              
7 2     2   862 use Carp;
  2         4  
  2         153  
8              
9 2     2   417 use Net::EGTS::Util qw(usize);
  2         3  
  2         121  
10 2     2   332 use Net::EGTS::Codes;
  2         178  
  2         1083  
11              
12             # Result Code
13             has RCD => is => 'rw', isa => 'BYTE', default => EGTS_PC_OK;
14              
15             after 'decode' => sub {
16             my ($self) = @_;
17             die 'SubRecord not EGTS_SR_RESULT_CODE type'
18             unless $self->SRT == EGTS_SR_RESULT_CODE;
19              
20             my $bin = $self->SRD;
21             $self->RCD( $self->nip(\$bin => 'C') );
22             };
23              
24             before 'encode' => sub {
25             my ($self) = @_;
26             die 'SubRecord not EGTS_SR_RESULT_CODE type'
27             unless $self->SRT == EGTS_SR_RESULT_CODE;
28              
29             $self->SRD( pack 'C' => $self->RCD );
30             };
31              
32             around BUILDARGS => sub {
33             my $orig = shift;
34             my $class = shift;
35              
36             # simple scalar decoding support
37             my $bin = @_ % 2 ? shift : undef;
38             my %opts = @_;
39              
40             return $class->$orig( bin => $bin, %opts, SRT => EGTS_SR_RESULT_CODE )
41             if $bin;
42             return $class->$orig( %opts, SRT => EGTS_SR_RESULT_CODE );
43             };
44              
45             augment as_debug => sub {
46             my ($self) = @_;
47 2     2   14 use bytes;
  2         10  
  2         22  
48              
49             my @bytes = ((unpack('B*', $self->SRD)) =~ m{.{8}}g);
50              
51             my @str;
52             push @str => sprintf('RCD: %s', splice @bytes, 0 => usize('C'));
53              
54             return @str;
55             };
56              
57             __PACKAGE__->meta->make_immutable();