File Coverage

lib/Net/EGTS/Packet/SignedAppdata.pm
Criterion Covered Total %
statement 27 27 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 36 36 100.0


line stmt bran cond sub pod time code
1 1     1   57216 use utf8;
  1         8  
  1         5  
2              
3             package Net::EGTS::Packet::SignedAppdata;
4 1     1   375 use namespace::autoclean;
  1         13151  
  1         3  
5 1     1   414 use Mouse;
  1         20908  
  1         3  
6             extends qw(Net::EGTS::Packet);
7              
8 1     1   281 use Carp;
  1         2  
  1         52  
9 1     1   415 use List::MoreUtils qw(natatime);
  1         9147  
  1         5  
10              
11 1     1   1041 use Net::EGTS::Types;
  1         72  
  1         25  
12 1     1   264 use Net::EGTS::Codes;
  1         61  
  1         196  
13 1     1   302 use Net::EGTS::Util qw(usize);
  1         3  
  1         294  
14              
15             # Signature Length
16             has SIGL => is => 'rw', isa => 'SHORT', default => 0;
17             # Signature Data
18             has SIGD => is => 'rw', isa => 'Maybe[BINARY]';
19             # Service Data Record
20             has SDR => is => 'rw', isa => 'Maybe[BINARY]';
21              
22             after 'decode' => sub {
23             my ($self) = @_;
24             die 'Packet not EGTS_PT_SIGNED_APPDATA type'
25             unless $self->PT == EGTS_PT_SIGNED_APPDATA;
26              
27             return unless defined $self->SFRD;
28             return unless length $self->SFRD;
29              
30             my $bin = $self->SFRD;
31             $self->SIGL( $self->nip(\$bin => 'S') );
32             $self->SIGD( $self->nip(\$bin => 'a*' => $self->SIGL ) );
33             $self->SDR( $self->nip(\$bin => 'a*' => length($bin)) );
34             };
35              
36             before 'encode' => sub {
37             my ($self) = @_;
38             die 'Packet not EGTS_PT_SIGNED_APPDATA type'
39             unless $self->PT == EGTS_PT_SIGNED_APPDATA;
40              
41             my $bin = pack 'S' => $self->SIGL;
42             $bin .= pack 'a*' => $self->SIGD if defined $self->SIGD;
43             $bin .= pack 'a*' => $self->SDR if defined $self->SDR;
44              
45             $self->SFRD( $bin );
46             };
47              
48             around BUILDARGS => sub {
49             my $orig = shift;
50             my $class = shift;
51             return $class->$orig( @_, PT => EGTS_PT_SIGNED_APPDATA );
52             };
53              
54             augment as_debug => sub {
55             my ($self) = @_;
56 1     1   5 use bytes;
  1         8  
  1         4  
57              
58             my @bytes = ((unpack('B*', $self->SFRD)) =~ m{.{8}}g);
59              
60             my @str;
61             push @str => sprintf('SIGL: %s %s', splice @bytes, 0 => usize('S'));
62              
63             my $it1 = natatime 4, splice @bytes, 0 => $self->SIGL;
64             my @chunks1;
65             while (my @vals = $it1->()) {
66             push @chunks1, join(' ', @vals);
67             }
68             push @str => sprintf('SIGD: %s', join("\n ", @chunks1));
69              
70             my $it2 = natatime 4, @bytes;
71             my @chunks2;
72             while (my @vals = $it2->()) {
73             push @chunks2, join(' ', @vals);
74             }
75             push @str => sprintf('SDR: %s', join("\n ", @chunks2));
76              
77             return @str;
78             };
79              
80             __PACKAGE__->meta->make_immutable();