File Coverage

blib/lib/Net/Frame/Layer/LLTD/Tlv.pm
Criterion Covered Total %
statement 22 26 84.6
branch 3 6 50.0
condition n/a
subroutine 6 8 75.0
pod 5 5 100.0
total 36 45 80.0


line stmt bran cond sub pod time code
1             #
2             # $Id: Tlv.pm 12 2015-01-14 06:29:59Z gomor $
3             #
4             package Net::Frame::Layer::LLTD::Tlv;
5 9     9   41 use strict; use warnings;
  9     9   13  
  9         327  
  9         39  
  9         9  
  9         309  
6              
7 9     9   43 use Net::Frame::Layer qw(:consts :subs);
  9         12  
  9         4242  
8             our @ISA = qw(Net::Frame::Layer);
9              
10             our @AS = qw(
11             type
12             length
13             value
14             );
15             __PACKAGE__->cgBuildIndices;
16             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
17              
18             sub new {
19             shift->SUPER::new(
20 1     1 1 19 type => 0,
21             length => 0,
22             value => '',
23             @_,
24             );
25             }
26              
27 0     0 1 0 sub getLength { 2 + shift->length }
28              
29             sub pack {
30 1     1 1 186 my $self = shift;
31              
32 1 50       5 $self->raw($self->SUPER::pack('CCa*',
33             $self->type, $self->length, $self->value,
34             )) or return undef;
35              
36 1         70 $self->raw;
37             }
38              
39             sub unpack {
40 1     1 1 10 my $self = shift;
41              
42 1 50       3 my ($type, $length, $tail) = $self->SUPER::unpack('CC a*', $self->raw)
43             or return undef;
44              
45 1         25 my $bLen = $length;
46 1 50       5 my ($value, $payload) = $self->SUPER::unpack("a$bLen a*", $tail)
47             or return undef;
48              
49 1         11 $self->type($type);
50 1         8 $self->length($length);
51 1         7 $self->value($value);
52              
53 1         9 $self->payload($payload);
54              
55 1         7 $self;
56             }
57              
58             sub print {
59 0     0 1   my $self = shift;
60              
61 0           my $l = $self->layer;
62 0           sprintf "$l: type:%02x length:%02x value:%s",
63             $self->type, $self->length, CORE::unpack('H*', $self->value);
64             }
65              
66             1;
67              
68             __END__