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

my $test = '0x4000040000000200800000000000000000000002'
            .'0000000000c004000108008000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000';
my $bits;

$bits = showbits($test);

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

$bits = showbits(xlat($test));
@s = ranges($bits);
print join(',',@s);

$bits = showbits(xlat(xlat($test)));
@s = ranges($bits);
print join(',',@s);

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

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

##</code><code>##

my $ports = '0x4000040000000200800000000000000000000002'
            .'0000000000c004000108008000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000';
my $basePort = 0;
my @ports;

$ports = substr $ports, 2;

while ($ports) {
    my $octet = hex substr $ports, 0, 2, '';
    my $index = 0;
    
    while ($octet) {
        next unless $octet & 0x80;
        push @ports, $basePort + $index;
    } continue {
        ++$index;
        $octet = ($octet << 1) & 0xff;
    }
    
    $basePort += 8;
}

print join ',', @ports;

##</code><code>##

my $ports = '0x4000040000000200800000000000000000000002'
            .'0000000000c004000108008000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000000000000000000000000000000000'
            .'00000000000';
my $basePort = 0;
my @ports;

$ports = substr $ports, 2;

while ($ports) {
    my $octet = hex substr $ports, 0, 2, '';
    my $index = 0;
    
    while ($octet) {
        next unless $octet & 0x80;
        push @ports, $basePort + $index;
    } continue {
        ++$index;
        $octet = ($octet << 1) & 0xff;
    }
    
    $basePort += 8;
}

print join ',', @ports,"\n";
range_format(@ports);

sub range_format{

my (@numbers,$i,$start,$end);
@numbers = @_;

for ($i = 0; $i < @numbers; ++$i){
    
    my $prev = $numbers[$i-1];
    my $next = $numbers[$i+1];
    my $cur = $numbers[$i];
    
    if (($cur+1 == $next) and ($cur-1!= $prev)){
        $start = $cur;
    }
    if (($cur-1 == $prev) and ($cur+1 != $next)){
        $end = $cur;
    }
    if ((defined $start) and (defined $end)){
        print "$start-$end,";
        $start = undef;
        $end = undef;
    }else{
        unless((defined $start)||(defined $end)){print "$cur,";}}
}
}