File Coverage

lib/Net/EGTS/SubRecord/Auth/RecordResponse.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   54795 use utf8;
  2         13  
  2         12  
2              
3             package Net::EGTS::SubRecord::Auth::RecordResponse;
4 2     2   459 use Mouse;
  2         20978  
  2         9  
5             extends qw(Net::EGTS::SubRecord);
6              
7 2     2   717 use Carp;
  2         2  
  2         141  
8              
9 2     2   337 use Net::EGTS::Util qw(usize);
  2         5  
  2         98  
10 2     2   294 use Net::EGTS::Codes;
  2         88  
  2         985  
11              
12             # Confirmed Record Number
13             has CRN => is => 'rw', isa => 'USHORT', default => 0;
14             # Record Status
15             has RST => is => 'rw', isa => 'BYTE', default => 0;
16              
17             after 'decode' => sub {
18             my ($self) = @_;
19             die 'SubRecord not EGTS_SR_RECORD_RESPONSE type'
20             unless $self->SRT == EGTS_SR_RECORD_RESPONSE;
21              
22             my $bin = $self->SRD;
23              
24             $self->CRN( $self->nip(\$bin => 'S') );
25             $self->RST( $self->nip(\$bin => 'C') );
26             };
27              
28             before 'encode' => sub {
29             my ($self) = @_;
30             die 'SubRecord not EGTS_SR_RECORD_RESPONSE type'
31             unless $self->SRT == EGTS_SR_RECORD_RESPONSE;
32              
33             $self->SRD( pack 'SC' => $self->CRN, $self->RST );
34             };
35              
36             around BUILDARGS => sub {
37             my $orig = shift;
38             my $class = shift;
39              
40             # simple scalar decoding support
41             my $bin = @_ % 2 ? shift : undef;
42             my %opts = @_;
43              
44             return $class->$orig( bin => $bin, %opts, SRT => EGTS_SR_RECORD_RESPONSE )
45             if $bin;
46             return $class->$orig( %opts, SRT => EGTS_SR_RECORD_RESPONSE );
47             };
48              
49             augment as_debug => sub {
50             my ($self) = @_;
51 2     2   11 use bytes;
  2         4  
  2         14  
52              
53             my @bytes = ((unpack('B*', $self->SRD)) =~ m{.{8}}g);
54              
55             my @str;
56             push @str => sprintf('CRN: %s %s', splice @bytes, 0 => usize('S'));
57             push @str => sprintf('RST: %s', splice @bytes, 0 => usize('C'));
58              
59             return @str;
60             };
61              
62             __PACKAGE__->meta->make_immutable();