File Coverage

blib/lib/Net/Frame/Layer/STP.pm

Criterion	Covered	Total	%
statement	44	49	89.8
branch	2	4	50.0
condition			n/a
subroutine	9	12	75.0
pod	6	6	100.0
total	61	71	85.9

#
# $Id: STP.pm,v 1.2 2007/01/04 23:30:34 gomor Exp $
#
package Net::Frame::Layer::STP;
use strict;
use warnings;

our $VERSION = '1.01';

use Net::Frame::Layer qw(:consts);
require Exporter;
our @ISA = qw(Net::Frame::Layer Exporter);

our %EXPORT_TAGS = (
   consts => [qw(
      NF_STP_HDR_LEN
      NF_STP_PROTOCOL_IDENTIFIER_STP
   )],
);
our @EXPORT_OK = (
   @{$EXPORT_TAGS{consts}},
);

use constant NF_STP_HDR_LEN                 => 42;
use constant NF_STP_PROTOCOL_IDENTIFIER_STP => 0x0000;

our @AS = qw(
   protocolIdentifier
   protocolVersionIdentifier
   bpduType
   bpduFlags
   rootIdentifier
   rootPathCost
   bridgeIdentifier
   portIdentifier
   messageAge
   maxAge
   helloTime
   forwardDelay
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

use Net::Frame::Layer qw(:subs);

sub new {
   shift->SUPER::new(
      protocolIdentifier        => NF_STP_PROTOCOL_IDENTIFIER_STP,
      protocolVersionIdentifier => 0,
      bpduType                  => 0x00,
      bpduFlags                 => 0x00,
      rootIdentifier            => '1/00:11:22:33:44:55',
      rootPathCost              => 1,
      bridgeIdentifier          => '2/11:22:33:44:55:66',
      portIdentifier            => 0x0001,
      messageAge                => 1,
      maxAge                    => 10,
      helloTime                 => 1,
      forwardDelay              => 10,
      @_,
   );
}

sub getLength { NF_STP_HDR_LEN }

sub pack {
   my $self = shift;

   my ($root, $id1)   = split('\s*/\s*', $self->rootIdentifier);
   my ($bridge, $id2) = split('\s*/\s*', $self->bridgeIdentifier);

   $id1 =~ s/://g;
   $id2 =~ s/://g;

   $self->raw($self->SUPER::pack('nCCCnH12NnH12nvvvv',
      $self->protocolIdentifier, $self->protocolVersionIdentifier,
      $self->bpduType, $self->bpduFlags, $root, $id1, $self->rootPathCost,
      $bridge, $id2, $self->portIdentifier, $self->messageAge, $self->maxAge,
      $self->helloTime, $self->forwardDelay)
   ) or return undef;

   $self->raw;
}

sub unpack {
   my $self = shift;

   my ($protocolIdentifier, $protocolVersionIdentifier, $bpduType, $bpduFlags,
      $root, $identifier1, $rootPathCost, $bridge, $identifier2,
      $portIdentifier, $messageAge, $maxAge, $helloTime, $forwardDelay,
      $payload) = $self->SUPER::unpack('nCCCnH12NnH12nvvvv a*', $self->raw)
         or return undef;

   my $id1 = $root.'/'.convertMac($identifier1);
   my $id2 = $bridge.'/'.convertMac($identifier2);
   $self->rootIdentifier($id1);
   $self->bridgeIdentifier($id2);

   $self->protocolIdentifier($protocolIdentifier);
   $self->protocolVersionIdentifier($protocolVersionIdentifier);
   $self->bpduType($bpduType);
   $self->bpduFlags($bpduFlags);
   $self->rootPathCost($rootPathCost);
   $self->portIdentifier($portIdentifier);
   $self->messageAge($messageAge);
   $self->maxAge($maxAge);
   $self->helloTime($helloTime);
   $self->forwardDelay($forwardDelay);

   $self->payload($payload);

   $self;
}

sub encapsulate { shift->nextLayer }

sub print {
   my $self = shift;

   my $l = $self->layer;
   sprintf "$l: protocolIdentifier:0x%04x  protocolVersionIdentifier:%d\n".
           "$l: bpduType:0x%02x  bpduFlags:0x%02x\n".
           "$l: rootIdentifier:%s  rootPathCost:%d\n".
           "$l: bridgeIdentifier:%s  portIdentifier:0x%04x\n".
           "$l: messageAge:%d  maxAge:%d  helloTime:%d  forwardDelay:%d",
              $self->protocolIdentifier, $self->protocolVersionIdentifier,
              $self->bpduType, $self->bpduFlags, $self->rootIdentifier,
              $self->rootPathCost, $self->bridgeIdentifier,
              $self->portIdentifier, $self->messageAge, $self->maxAge,
              $self->helloTime, $self->forwardDelay;
}

1;

__END__