Net::Packet::VLAN - 802.1Q layer 3 object

   use Net::Packet::Consts qw(:vlan);
   require Net::Packet::VLAN;

   # Build a layer
   my $layer = Net::Packet::VLAN->new(
      priority => 0,
      cfi      => 0,
      id       => 0,
      type     => NP_VLAN_TYPE_IPv4,
   );
   $layer->pack;

   print 'RAW: '.unpack('H*', $layer->raw)."\n";

   # Read a raw layer
   my $layer = Net::Packet::VLAN->new(raw => $raw);

   print $layer->print."\n";
   print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n"
      if $layer->payload;

#
# $Id: VLAN.pm 1640 2009-11-09 17:58:27Z gomor $
#
package Net::Packet::VLAN;
use strict;
use warnings;

require Net::Packet::Layer3;
our @ISA = qw(Net::Packet::Layer3);

use Net::Packet::Env qw($Env);
use Net::Packet::Consts qw(:vlan :layer);
require Net::Packet::Frame;
require Bit::Vector;

our @AS = qw(
   priority
   cfi
   id
   type
   frame
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

no strict 'vars';

sub new {
   shift->SUPER::new(
      priority => 0,
      cfi      => 0,
      id       => 0,
      type     => NP_VLAN_TYPE_IPv4,
      @_,
   );
}

sub getLength {
   my $self = shift;
   # Keep old behaviour for backward compat
   if (! $Env->doFrameReturnList) {
      my $frame = $self->[$__frame];
      return(length($frame->raw) + NP_VLAN_HDR_LEN) if $frame;
   }
   NP_VLAN_HDR_LEN;
}

sub pack {
   my $self = shift;

   my $v3  = Bit::Vector->new_Dec(3,  $self->[$__priority]);
   my $v1  = Bit::Vector->new_Dec(1,  $self->[$__cfi]);
   my $v12 = Bit::Vector->new_Dec(12, $self->[$__id]);
   my $v16 = $v3->Concat_List($v1, $v12);

   $self->[$__raw] = $self->SUPER::pack('nn',
      $v16->to_Dec,
      $self->[$__type],
   ) or return undef;

   # Keep old behaviour for backward compat
   if (! $Env->doFrameReturnList) {
      if ($self->[$__frame] && $self->[$__frame]->raw) {
         $self->[$_raw] .= $self->SUPER::pack('a*',
            $self->[$__frame]->raw,
         );
      }
   }

   1;
}

sub unpack {
   my $self = shift;

   my ($pCfiId, $type, $payload) =
      $self->SUPER::unpack('nn a*', $self->[$__raw])
         or return undef;

   my $v16 = Bit::Vector->new_Dec(16, $pCfiId);

   $self->[$__priority] = $v16->Chunk_Read(3, 13);
   $self->[$__cfi]      = $v16->Chunk_Read(1, 12);
   $self->[$__id]       = $v16->Chunk_Read(12, 0);
   $self->[$__type]     = $type;

   # Keep old behaviour for backward compat
   if (! $Env->doFrameReturnList) {
      $self->[$__frame] = Net::Packet::Frame->new(
         raw         => $payload,
         encapsulate => $self->encapsulate,
      );
   }
   else {
      $self->[$__payload] = $payload;
   }

   1;
}

sub encapsulate {
   my $self = shift;

   my $types = {
      NP_VLAN_TYPE_IPv4() => NP_LAYER_IPv4(),
      NP_VLAN_TYPE_IPv6() => NP_LAYER_IPv6(),
      NP_VLAN_TYPE_ARP()  => NP_LAYER_ARP(),
      NP_VLAN_TYPE_VLAN() => NP_LAYER_VLAN(),
   };

   if ($self->[$__type] <= 1500 && $self->[$__payload]) {
      my $payload = CORE::unpack('H*', $self->[$__payload]);
      if ($payload =~ /^aaaa/) {
         return NP_LAYER_LLC();
      }
      return NP_LAYER_UNKNOWN();
   }
   else {
      $types->{$self->type} || NP_LAYER_UNKNOWN();
   }
}

sub print {
   my $self = shift;

   my $l = $self->layer;
   my $i = $self->is;
   sprintf "$l:+$i: priority:0x%01x  cfi:0x%01x  id:0x%02x  type:0x%02x",
      $self->[$__priority], $self->[$__cfi], $self->[$__id], $self->[$__type];
}

#
# Helpers
#

sub _isType    { shift->[$__type] == shift()                      }
sub isTypeArp  { shift->_isType(NP_VLAN_TYPE_ARP)                 }
sub isTypeVlan { shift->_isType(NP_VLAN_TYPE_VLAN)                }
sub isTypeIpv4 { shift->_isType(NP_VLAN_TYPE_IPv4)                }
sub isTypeIpv6 { shift->_isType(NP_VLAN_TYPE_IPv6)                }
sub isTypeIp   { my $self = shift; $self->isIpv4 || $self->isIpv6 }

1;

__END__