File Coverage

blib/lib/Net/DNS/Extlang/Nsechelp.pm

Criterion	Covered	Total	%
statement	45	61	73.7
branch	4	8	50.0
condition	3	6	50.0
subroutine	6	8	75.0
pod			n/a
total	58	83	69.8

## NSEC and NSEC3 bitmaps and base32
package Net::DNS::Extlang::Nsechelp;

our $VERSION = '0.1';
=head1 NAME

Net::DNS::Extlang::Nsechelp - Helper routines for compiled NSEC and
NSEC3 resource records

Called only from Extlang generated code.  No user servicable parts.

=cut

use base qw(Exporter);
use vars qw(@EXPORT);
@EXPORT = qw(_type2bm _bm2type _encode_base32 _decode_base32);

use strict;
use Net::DNS::Parameters qw(typebyname typebyval);

sub _type2bm {
	my @typearray;
	foreach my $typename ( map split(), @_ ) {
		my $number = typebyname($typename);
		my $window = $number >> 8;
		my $bitnum = $number & 255;
		my $octet  = $bitnum >> 3;
		my $bit	   = $bitnum & 7;
		$typearray[$window][$octet] |= 0x80 >> $bit;
	}

	my $bitmap = '';
	my $window = 0;
	foreach (@typearray) {
		if ( my $pane = $typearray[$window] ) {
			my @content = map $_ || 0, @$pane;
			$bitmap .= pack 'CC C*', $window, scalar(@content), @content;
		}
		$window++;
	}

	return $bitmap;
}


sub _bm2type {
	my @typelist;
	my $bitmap = shift || return @typelist;

	my $index = 0;
	my $limit = length $bitmap;

	while ( $index < $limit ) {
		my ( $block, $size ) = unpack "\@$index C2", $bitmap;
		my $typenum = $block << 8;
		foreach my $octet ( unpack "\@$index xxC$size", $bitmap ) {
			my $i = $typenum += 8;
			my @name;
			while ($octet) {
				--$i;
				unshift @name, typebyval($i) if $octet & 1;
				$octet = $octet >> 1;
			}
			push @typelist, @name;
		}
		$index += $size + 2;
	}

	return @typelist;
}

sub _decode_base32 {
	local $_ = shift || '';
	tr [0-9a-vA-V] [\000-\037\012-\037];
	$_ = unpack 'B*', $_;
	s/000(.....)/$1/g;
	my $l = length;
	$_ = substr $_, 0, $l & ~7 if $l & 7;
	pack 'B*', $_;
}


sub _encode_base32 {
	local $_ = unpack 'B*', shift;
	s/(.....)/000$1/g;
	my $l = length;
	my $x = substr $_, $l & ~7;
	my $n = length $x;
	substr( $_, $l & ~7 ) = join '', '000', $x, '0' x ( 5 - $n ) if $n;
	$_ = pack( 'B*', $_ );
	tr [\000-\037] [0-9a-v];
	return $_;
}
1;
__END__