File Coverage

blib/lib/Net/Frame/Layer/STP.pm
Criterion Covered Total %
statement 47 52 90.3
branch 2 4 50.0
condition n/a
subroutine 10 13 76.9
pod 6 6 100.0
total 65 75 86.6


line stmt bran cond sub pod time code
1             #
2             # $Id: STP.pm 8 2015-01-14 06:55:14Z gomor $
3             #
4             package Net::Frame::Layer::STP;
5 2     2   14832 use strict; use warnings;
  2     2   5  
  2         84  
  2         11  
  2         5  
  2         163  
6              
7             our $VERSION = '1.02';
8              
9 2     2   1420 use Net::Frame::Layer qw(:consts);
  2         3632363  
  2         426  
10 2     2   19 use Exporter;
  2         2  
  2         175  
11             our @ISA = qw(Net::Frame::Layer Exporter);
12              
13             our %EXPORT_TAGS = (
14             consts => [qw(
15             NF_STP_HDR_LEN
16             NF_STP_PROTOCOL_IDENTIFIER_STP
17             )],
18             );
19             our @EXPORT_OK = (
20             @{$EXPORT_TAGS{consts}},
21             );
22              
23 2     2   8 use constant NF_STP_HDR_LEN => 42;
  2         3  
  2         107  
24 2     2   9 use constant NF_STP_PROTOCOL_IDENTIFIER_STP => 0x0000;
  2         3  
  2         132  
25              
26             our @AS = qw(
27             protocolIdentifier
28             protocolVersionIdentifier
29             bpduType
30             bpduFlags
31             rootIdentifier
32             rootPathCost
33             bridgeIdentifier
34             portIdentifier
35             messageAge
36             maxAge
37             helloTime
38             forwardDelay
39             );
40             __PACKAGE__->cgBuildIndices;
41             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
42              
43 2     2   8 use Net::Frame::Layer qw(:subs);
  2         4  
  2         1409  
44              
45             sub new {
46             shift->SUPER::new(
47 1     1 1 21 protocolIdentifier => NF_STP_PROTOCOL_IDENTIFIER_STP,
48             protocolVersionIdentifier => 0,
49             bpduType => 0x00,
50             bpduFlags => 0x00,
51             rootIdentifier => '1/00:11:22:33:44:55',
52             rootPathCost => 1,
53             bridgeIdentifier => '2/11:22:33:44:55:66',
54             portIdentifier => 0x0001,
55             messageAge => 1,
56             maxAge => 10,
57             helloTime => 1,
58             forwardDelay => 10,
59             @_,
60             );
61             }
62              
63 0     0 1 0 sub getLength { NF_STP_HDR_LEN }
64              
65             sub pack {
66 1     1 1 346 my $self = shift;
67              
68 1         4 my ($root, $id1) = split('\s*/\s*', $self->rootIdentifier);
69 1         34 my ($bridge, $id2) = split('\s*/\s*', $self->bridgeIdentifier);
70              
71 1         13 $id1 =~ s/://g;
72 1         4 $id2 =~ s/://g;
73              
74 1 50       5 $self->raw($self->SUPER::pack('nCCCnH12NnH12nvvvv',
75             $self->protocolIdentifier, $self->protocolVersionIdentifier,
76             $self->bpduType, $self->bpduFlags, $root, $id1, $self->rootPathCost,
77             $bridge, $id2, $self->portIdentifier, $self->messageAge, $self->maxAge,
78             $self->helloTime, $self->forwardDelay)
79             ) or return undef;
80              
81 1         86 $self->raw;
82             }
83              
84             sub unpack {
85 1     1 1 9 my $self = shift;
86              
87 1 50       3 my ($protocolIdentifier, $protocolVersionIdentifier, $bpduType, $bpduFlags,
88             $root, $identifier1, $rootPathCost, $bridge, $identifier2,
89             $portIdentifier, $messageAge, $maxAge, $helloTime, $forwardDelay,
90             $payload) = $self->SUPER::unpack('nCCCnH12NnH12nvvvv a*', $self->raw)
91             or return undef;
92              
93 1         30 my $id1 = $root.'/'.convertMac($identifier1);
94 1         11 my $id2 = $bridge.'/'.convertMac($identifier2);
95 1         7 $self->rootIdentifier($id1);
96 1         10 $self->bridgeIdentifier($id2);
97              
98 1         7 $self->protocolIdentifier($protocolIdentifier);
99 1         8 $self->protocolVersionIdentifier($protocolVersionIdentifier);
100 1         6 $self->bpduType($bpduType);
101 1         7 $self->bpduFlags($bpduFlags);
102 1         10 $self->rootPathCost($rootPathCost);
103 1         10 $self->portIdentifier($portIdentifier);
104 1         11 $self->messageAge($messageAge);
105 1         11 $self->maxAge($maxAge);
106 1         11 $self->helloTime($helloTime);
107 1         11 $self->forwardDelay($forwardDelay);
108              
109 1         18 $self->payload($payload);
110              
111 1         9 $self;
112             }
113              
114 0     0 1   sub encapsulate { shift->nextLayer }
115              
116             sub print {
117 0     0 1   my $self = shift;
118              
119 0           my $l = $self->layer;
120 0           sprintf "$l: protocolIdentifier:0x%04x protocolVersionIdentifier:%d\n".
121             "$l: bpduType:0x%02x bpduFlags:0x%02x\n".
122             "$l: rootIdentifier:%s rootPathCost:%d\n".
123             "$l: bridgeIdentifier:%s portIdentifier:0x%04x\n".
124             "$l: messageAge:%d maxAge:%d helloTime:%d forwardDelay:%d",
125             $self->protocolIdentifier, $self->protocolVersionIdentifier,
126             $self->bpduType, $self->bpduFlags, $self->rootIdentifier,
127             $self->rootPathCost, $self->bridgeIdentifier,
128             $self->portIdentifier, $self->messageAge, $self->maxAge,
129             $self->helloTime, $self->forwardDelay;
130             }
131              
132             1;
133              
134             __END__