File Coverage

blib/lib/Net/Frame/Layer/ICMPv6/Option.pm
Criterion Covered Total %
statement 25 31 80.6
branch 4 8 50.0
condition 1 3 33.3
subroutine 7 9 77.7
pod 5 5 100.0
total 42 56 75.0


line stmt bran cond sub pod time code
1             #
2             # $Id: Option.pm,v bc01789674fd 2019/05/23 05:51:45 gomor $
3             #
4             package Net::Frame::Layer::ICMPv6::Option;
5 2     2   12 use strict; use warnings;
  2     2   3  
  2         46  
  2         8  
  2         2  
  2         47  
6              
7 2     2   8 use Net::Frame::Layer qw(:consts :subs);
  2         4  
  2         335  
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 2     2   13 use Net::Frame::Layer::ICMPv6 qw(:consts);
  2         4  
  2         840  
19              
20             sub new {
21             shift->SUPER::new(
22 1     1 1 13 type => 0,
23             length => 0,
24             value => '',
25             @_,
26             );
27             }
28              
29             sub getLength {
30 0     0 1 0 my $self = shift;
31              
32 0         0 return length($self->value) + 2;
33             }
34              
35             sub pack {
36 1     1 1 193 my $self = shift;
37              
38 1 50       5 $self->raw($self->SUPER::pack('CCa*',
39             $self->type, $self->length, $self->value,
40             )) or return;
41              
42 1         50 return $self->raw;
43             }
44              
45             sub unpack {
46 1     1 1 9 my $self = shift;
47              
48 1 50       4 my ($type, $length, $tail) = $self->SUPER::unpack('CC a*', $self->raw)
49             or return;
50              
51 1         22 $self->type($type);
52 1         10 $self->length($length);
53              
54             # Dirty hack. Some systems does not set the length correctly
55 1 50 33     11 if ($type == NF_ICMPv6_OPTION_TARGETLINKLAYERADDRESS
56             || $type == NF_ICMPv6_OPTION_SOURCELINKLAYERADDRESS) {
57 0         0 $length = 6;
58             }
59              
60 1 50       13 my ($value, $payload) = $self->SUPER::unpack("a$length a*", $tail)
61             or return;
62              
63 1         17 $self->value($value);
64 1         13 $self->payload($payload);
65              
66 1         12 return $self;
67             }
68              
69             sub print {
70 0     0 1   my $self = shift;
71              
72 0           my $l = $self->layer;
73 0           sprintf "$l: type:%02x length:%02x value:%s",
74             $self->type, $self->length, CORE::unpack('H*', $self->value);
75             }
76              
77             1;
78              
79             __END__