File Coverage

lib/Net/BART/Art.pm
Criterion Covered Total %
statement 32 34 94.1
branch 6 6 100.0
condition n/a
subroutine 8 9 88.8
pod 0 5 0.0
total 46 54 85.1


line stmt bran cond sub pod time code
1             package Net::BART::Art;
2              
3 2     2   75825 use strict;
  2         3  
  2         79  
4 2     2   8 use warnings;
  2         7  
  2         130  
5 2     2   9 use Exporter 'import';
  2         3  
  2         652  
6              
7             our $VERSION = '0.01';
8              
9             our @EXPORT_OK = qw(
10             pfx_to_idx
11             octet_to_idx
12             idx_to_pfx
13             pfx_bits
14             prefix_decompose
15             );
16              
17             # Map a prefix (octet + prefix length within stride 1..7) to a base index [1..255].
18             sub pfx_to_idx {
19 261     261 0 418714 my ($octet, $pfx_len) = @_;
20 261         607 return ($octet >> (8 - $pfx_len)) + (1 << $pfx_len);
21             }
22              
23             # Map a full octet to its /7 index [128..255] for LPM lookup.
24             sub octet_to_idx {
25 5     5 0 10 my ($octet) = @_;
26 5         22 return ($octet >> 1) + 128;
27             }
28              
29             # Inverse: from base index [1..255] back to (octet, pfx_len).
30             sub idx_to_pfx {
31 255     255 0 657 my ($idx) = @_;
32 255         372 my $pfx_len = _bit_len8($idx) - 1;
33 255         347 my $octet = ($idx - (1 << $pfx_len)) << (8 - $pfx_len);
34 255         436 return ($octet, $pfx_len);
35             }
36              
37             # Total prefix bits at a given trie depth and base index.
38             sub pfx_bits {
39 0     0 0 0 my ($depth, $idx) = @_;
40 0         0 return $depth * 8 + (_bit_len8($idx) - 1);
41             }
42              
43             # Decompose a prefix length into:
44             # $strides - number of full 8-bit octets consumed
45             # $lastbits - remaining prefix bits (0..7) in the final octet
46             #
47             # strides = floor(prefix_len / 8), lastbits = prefix_len % 8
48             #
49             # If lastbits > 0: traverse strides octets, store prefix at depth strides
50             # If lastbits == 0 and prefix_len > 0: it's a "fringe" (stride-aligned)
51             # traverse strides-1 octets, store fringe child at depth strides-1
52             # If prefix_len == 0: default route, store at root index 1
53             sub prefix_decompose {
54 6     6 0 5812 my ($prefix_len) = @_;
55 6         19 return (int($prefix_len / 8), $prefix_len % 8);
56             }
57              
58             sub _bit_len8 {
59 255     255   244 my ($x) = @_;
60 255         234 my $n = 0;
61 255 100       568 if ($x & 0xF0) { $n += 4; $x >>= 4; }
  240         234  
  240         246  
62 255 100       362 if ($x & 0x0C) { $n += 2; $x >>= 2; }
  204         160  
  204         237  
63 255 100       421 if ($x & 0x02) { $n += 1; $x >>= 1; }
  170         145  
  170         171  
64 255         196 $n += $x;
65 255         299 return $n;
66             }
67              
68             1;