File Coverage

blib/lib/Net/Frame/Layer/IPv6/Option.pm
Criterion Covered Total %
statement 26 43 60.4
branch 7 20 35.0
condition n/a
subroutine 6 9 66.6
pod 6 6 100.0
total 45 78 57.6


line stmt bran cond sub pod time code
1             #
2             # $Id: Option.pm 47 2015-01-20 18:20:28Z gomor $
3             #
4             package Net::Frame::Layer::IPv6::Option;
5 2     2   7 use strict;
  2         2  
  2         60  
6 2     2   6 use warnings;
  2         2  
  2         42  
7              
8 2     2   7 use Net::Frame::Layer qw(:consts :subs);
  2         2  
  2         986  
9             our @ISA = qw(Net::Frame::Layer);
10              
11             our @AS = qw(
12             type
13             length
14             value
15             );
16             __PACKAGE__->cgBuildIndices;
17             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
18              
19             sub new {
20             shift->SUPER::new(
21 1     1 1 13 type => 1,
22             length => 0,
23             value => '',
24             @_,
25             );
26             }
27              
28             sub getLength {
29 0     0 1 0 my $self = shift;
30              
31 0 0       0 if ($self->type == 0) { # Pad1, only type is used
32 0         0 return 1;
33             }
34              
35 0         0 return length($self->value) + 2;
36             }
37              
38             sub pack {
39 1     1 1 122 my $self = shift;
40              
41 1 50       3 my $raw = $self->SUPER::pack('C', $self->type)
42             or return;
43              
44 1 50       24 if ($self->type != 0) { # Not a Pad1 option
45 1 50       14 $raw .= $self->SUPER::pack('Ca*', $self->length, $self->value)
46             or return;
47             }
48              
49 1         24 return $self->raw($raw);
50             }
51              
52             sub unpack {
53 1     1 1 15 my $self = shift;
54              
55 1 50       5 my ($type, $payload) = $self->SUPER::unpack('C a*', $self->raw)
56             or return;
57 1         18 $self->type($type);
58              
59 1 50       8 if ($self->type != 0) { # Not a Pad1 option
60 1 50       9 my ($length, $tail) = $self->SUPER::unpack('C a*', $payload)
61             or return;
62              
63 1         8 my $value = '';
64 1 50       4 ($value, $payload) = $self->SUPER::unpack("a$length a*", $tail)
65             or return;
66              
67 1         9 $self->length($length);
68 1         8 $self->value($value);
69             }
70              
71 1         9 $self->payload($payload);
72              
73 1         16 return $self;
74             }
75              
76             sub computeLengths {
77 0     0 1   my $self = shift;
78              
79 0           my $length = 0;
80 0 0         if ($self->type != 0) { # Not a Pad1 option
81 0           $length = length($self->value);
82             }
83 0           $self->length($length);
84              
85 0           return 1;
86             }
87              
88             sub print {
89 0     0 1   my $self = shift;
90              
91 0           my $buf = '';
92 0           my $l = $self->layer;
93 0 0         if ($self->type == 0x00) { # Pad1 specific type
94 0           $buf .= sprintf "$l: type:0x%02x", $self->type;
95             }
96             else {
97 0           $buf .= sprintf "$l: type:0x%02x length:%d value:%s",
98             $self->type, $self->length, CORE::unpack('H*', $self->value);
99             }
100              
101 0           return $buf;
102             }
103              
104             1;
105              
106             __END__