File Coverage

blib/lib/Net/Frame/Layer/IPv6/HopByHop.pm
Criterion Covered Total %
statement 33 71 46.4
branch 4 14 28.5
condition 1 6 16.6
subroutine 9 15 60.0
pod 8 8 100.0
total 55 114 48.2


line stmt bran cond sub pod time code
1             #
2             # $Id: HopByHop.pm 47 2015-01-20 18:20:28Z gomor $
3             #
4             package Net::Frame::Layer::IPv6::HopByHop;
5 2     2   926 use strict; use warnings;
  2     2   2  
  2         64  
  2         6  
  2         3  
  2         73  
6              
7             our $VERSION = '1.07';
8              
9 2     2   8 use Net::Frame::Layer qw(:consts :subs);
  2         3  
  2         339  
10 2     2   11 use Exporter;
  2         4  
  2         191  
11             our @ISA = qw(Net::Frame::Layer Exporter);
12              
13             our @AS = qw(
14             nextHeader
15             hdrExtLen
16             );
17             our @AA = qw(
18             options
19             );
20             __PACKAGE__->cgBuildIndices;
21             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
22             __PACKAGE__->cgBuildAccessorsArray(\@AA);
23              
24 2     2   10 use Net::Frame::Layer::IPv6 qw(:consts);
  2         2  
  2         518  
25 2     2   720 use Net::Frame::Layer::IPv6::Option;
  2         4  
  2         1006  
26              
27             sub new {
28             shift->SUPER::new(
29 1     1 1 14 nextHeader => NF_IPv6_PROTOCOL_TCP,
30             hdrExtLen => 0,
31             options => [],
32             @_,
33             );
34             }
35              
36             sub getOptionsLength {
37 0     0 1 0 my $self = shift;
38 0         0 my $len = 0;
39 0         0 $len += $_->getLength for $self->options;
40 0         0 return $len;
41             }
42              
43             sub getLength {
44 0     0 1 0 my $self = shift;
45 0         0 return 2 + $self->getOptionsLength;
46             }
47              
48             sub pack {
49 1     1 1 129 my $self = shift;
50              
51 1 50       3 my $raw = $self->SUPER::pack('CC',
52             $self->nextHeader, $self->hdrExtLen
53             ) or return;
54              
55 1         34 for ($self->options) {
56 0         0 $raw .= $_->pack;
57             }
58              
59 1         15 return $self->raw($raw);
60             }
61              
62             sub _unpackOptions {
63 0     0   0 my $self = shift;
64 0         0 my ($payload) = @_;
65              
66 0         0 my @options = ();
67 0   0     0 while (defined($payload) && length($payload)) {
68 0         0 my $opt = Net::Frame::Layer::IPv6::Option->new(raw => $payload)->unpack;
69 0         0 push @options, $opt;
70 0         0 $payload = $opt->payload;
71 0         0 $opt->payload(undef);
72             }
73 0         0 $self->options(\@options);
74              
75 0         0 return $payload;
76             }
77              
78             sub unpack {
79 1     1 1 14 my $self = shift;
80              
81 1 50       2 my ($nextHeader, $hdrExtLen, $payload) =
82             $self->SUPER::unpack('CC a*', $self->raw)
83             or return;
84              
85 1         20 $self->nextHeader($nextHeader);
86 1         7 $self->hdrExtLen($hdrExtLen);
87              
88 1         6 my $options = '';
89 1         2 my $optionsLen = $hdrExtLen*8 + 6; # 8 - 2 bytes offset
90 1 50       6 ($options, $payload) = $self->SUPER::unpack("a$optionsLen a*", $payload)
91             or return;
92              
93 1 50 33     15 if (defined($options) && length($options)) {
94 0         0 $self->_unpackOptions($options);
95             }
96              
97 1         5 $self->payload($payload);
98              
99 1         13 return $self;
100             }
101              
102             sub computeLengths {
103 0     0 1   my $self = shift;
104              
105 0           my $hdrExtLen = int($self->getLength/8) - 1;
106 0 0         if ($hdrExtLen < 0) {
107 0           $hdrExtLen = 0;
108             }
109 0           $self->hdrExtLen($hdrExtLen);
110              
111 0           for my $option ($self->options) {
112 0           $option->computeLengths;
113             }
114              
115 0           return 1;
116             }
117              
118             sub encapsulate {
119 0     0 1   my $self = shift;
120              
121 0 0         return $self->nextLayer if $self->nextLayer;
122              
123 0 0         if ($self->payload) {
124 0           my $next = $self->nextHeader;
125 0           return Net::Frame::Layer::IPv6->new(nextHeader => $next)->encapsulate;
126             }
127              
128 0           return NF_LAYER_NONE;
129             }
130              
131             sub print {
132 0     0 1   my $self = shift;
133              
134 0           my $l = $self->layer;
135 0           my $buf = sprintf
136             "$l: nextHeader:0x%02x hdrExtLen:%d",
137             $self->nextHeader, $self->hdrExtLen;
138              
139 0           for ($self->options) {
140 0           $buf .= "\n" . $_->print;
141             }
142              
143 0           return $buf;
144             }
145              
146             1;
147              
148             __END__