use strict ; use warnings ;

# This $test is the value of OID 'octets', rendered as hex characters

             #1234567890123456789012345678901234567890
my $test = '0x4000040000000200800000000000000000000002'
            .'0000000000c00400010800800000000000000000' ;
          # .'0000000000000000000000000000000000000000'
          # .'0000000000000000000000000000000000000000'
          # .'0000000000000000000000000000000000000000'
          # .'0000000000000000000000000000000000000000'
          # .'0000000000000000';

# This translates the hex characters to an 'octet' string

my $octets = from_hex($test) ;

# The untranslated octet string looks like this, in bits

print showbits($octets), "\n" ;

# Here we translate from the octet string to a Perl bit-vector

my $bits = xlat($octets) ;
print showbits($bits), "\n" ;

# Here we work out and show the VLAN ranges

my @s = ranges($bits);
print "Ranges: ", join(', ', @s), "\n" ;

# The various subroutines

sub from_hex {
  my ($hex) = @_ ;
  $hex =~ s/^0x//i ;
  return pack('H*', $hex) ;
} ;

sub to_hex {
  my ($bytes) = @_ ;
  return '0x'.unpack('H*', $bytes) ;
} ;

sub xlat {
  my ($octets) = @_ ;
  return pack('B*', unpack('b*', $octets)) ;
} ;

sub ranges{
  my $bits = shift;
  my $r = undef ;
  my @s = () ;
  for my $vn (1..length($bits) * 8) {
    if (vec($bits, $vn, 1)) {
      if (!defined($r)) { push @s, "$vn" ; $r = 0 ; }
                   else { $r = $vn ;                } ;
    }
    else {
      if (defined($r))  {
        if ($r) { $s[-1] .= "-$r" ; } ;
        $r = undef ;
      } ;
    } ;
  } ;
  return @s;
}

sub showbits {
  my ($octets) = @_ ;
  my $s = unpack('B*', $octets) ;
  $s =~ s/([01]{8})(?=[01])/$1:/g ;
  $s =~ s/(?<=:)0{8}(?=:)//g ;
  return $s ;
} ;