File Coverage

lib/Net/EGTS/Packet/Appdata.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 5     5   55019 use utf8;
  5         14  
  5         20  
2              
3             package Net::EGTS::Packet::Appdata;
4 5     5   485 use namespace::autoclean;
  5         13227  
  5         21  
5 5     5   603 use Mouse;
  5         20500  
  5         24  
6             extends qw(Net::EGTS::Packet);
7              
8 5     5   1796 use Carp;
  5         9  
  5         267  
9 5     5   443 use List::MoreUtils qw(natatime);
  5         9203  
  5         48  
10              
11 5     5   3106 use Net::EGTS::Types;
  5         78  
  5         109  
12 5     5   284 use Net::EGTS::Codes;
  5         68  
  5         1143  
13 5     5   300 use Net::EGTS::Util qw(usize);
  5         7  
  5         1028  
14              
15             # Service Data Record
16             has SDR => is => 'rw', isa => 'Maybe[BINARY]';
17              
18             after 'decode' => sub {
19             my ($self) = @_;
20             die 'Packet not EGTS_PT_APPDATA type'
21             unless $self->PT == EGTS_PT_APPDATA;
22              
23             $self->SDR( $self->SFRD );
24             };
25              
26             before 'encode' => sub {
27             my ($self) = @_;
28             die 'Packet not EGTS_PT_APPDATA type'
29             unless $self->PT == EGTS_PT_APPDATA;
30              
31             $self->SFRD( $self->SDR );
32             };
33              
34             around BUILDARGS => sub {
35             my $orig = shift;
36             my $class = shift;
37             return $class->$orig( @_, PT => EGTS_PT_APPDATA );
38             };
39              
40             augment as_debug => sub {
41             my ($self) = @_;
42 5     5   57 use bytes;
  5         7  
  5         32  
43              
44             my @bytes = ((unpack('B*', $self->SFRD)) =~ m{.{8}}g);
45              
46             my @str;
47              
48             my $it = natatime 4, @bytes;
49             my @chunks;
50             while (my @vals = $it->()) {
51             push @chunks, join(' ', @vals);
52             }
53             push @str => sprintf('SDR: %s', join("\n ", @chunks));
54              
55             return @str;
56             };
57              
58             __PACKAGE__->meta->make_immutable();