File Coverage

blib/lib/MaxMind/DB/Reader/PP.pm
Criterion Covered Total %
statement 109 110 99.0
branch 33 42 78.5
condition 3 3 100.0
subroutine 20 20 100.0
pod 0 2 0.0
total 165 177 93.2


line stmt bran cond sub pod time code
1             package MaxMind::DB::Reader::PP;
2              
3 21     21   3031139 use strict;
  21         90  
  21         607  
4 21     21   123 use warnings;
  21         53  
  21         526  
5 21     21   2661 use namespace::autoclean;
  21         91144  
  21         202  
6 21     21   2576 use autodie;
  21         28372  
  21         171  
7              
8             our $VERSION = '1.000014';
9              
10 21     21   116981 use Carp qw( confess );
  21         83  
  21         1263  
11 21     21   7049 use Math::BigInt ();
  21         154429  
  21         660  
12 21     21   3261 use MaxMind::DB::Types qw( Int );
  21         94958  
  21         1419  
13 21     21   11918 use Socket 1.87 qw( inet_pton AF_INET AF_INET6 );
  21         78396  
  21         3590  
14              
15 21     21   3044 use Moo;
  21         42342  
  21         236  
16 21     21   19315 use MooX::StrictConstructor;
  21         79891  
  21         187  
17              
18             with 'MaxMind::DB::Reader::Role::Reader',
19             'MaxMind::DB::Reader::Role::NodeReader',
20             'MaxMind::DB::Reader::Role::HasDecoder',
21             'MaxMind::DB::Role::Debugs';
22              
23             has _ipv4_start_node => (
24             is => 'ro',
25             isa => Int,
26             init_arg => undef,
27             lazy => 1,
28             builder => '_build_ipv4_start_node',
29             );
30              
31 21     21   122740 use constant DEBUG => $ENV{MAXMIND_DB_READER_DEBUG};
  21         60  
  21         13970  
32              
33             sub BUILD {
34 22     22 0 918 my $self = shift;
35              
36 22         109 my $file = $self->file;
37              
38 22 100       758 die qq{Error opening database file "$file": The file does not exist.}
39             unless -e $file;
40              
41 21 50       181 die qq{Error opening database file "$file": The file cannot be read.}
42             unless -r _;
43              
44             # Build the metadata right away to ensure file's validity
45 21         575 $self->metadata;
46              
47 20         879 return;
48             }
49              
50             sub _build_data_source {
51 21     21   243 my $self = shift;
52              
53 21         71 my $file = $self->file;
54 21         121 open my $fh, '<:raw', $file;
55              
56 21         10235 return $fh;
57             }
58              
59             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
60             sub _data_for_address {
61 203     203   404 my $self = shift;
62 203         376 my $addr = shift;
63              
64 203         485 my $pointer = $self->_find_address_in_tree($addr);
65              
66             ## no critic (Subroutines::ProhibitExplicitReturnUndef)
67 203 100       776 return undef unless $pointer;
68              
69 168         570 return $self->_get_entry_data($pointer);
70             }
71             ## use critic
72              
73             sub _find_address_in_tree {
74 203     203   391 my $self = shift;
75 203         287 my $addr = shift;
76              
77 203         537 my $is_ipv6_addr = $addr =~ /:/;
78              
79 203 100       729 my $packed_addr = inet_pton( $is_ipv6_addr ? AF_INET6 : AF_INET, $addr );
80              
81 203 50       526 die
82             "The IP address you provided ($addr) is not a valid IPv4 or IPv6 address"
83             unless defined $packed_addr;
84              
85 203         778 my @address_bytes = unpack( 'C*', $packed_addr );
86              
87             # The first node of the tree is always node 0, at the beginning of the
88             # value
89 203 100 100     4870 my $node = $self->ip_version == 6
90             && !$is_ipv6_addr ? $self->_ipv4_start_node : 0;
91              
92 203         8197 my $bit_length = @address_bytes * 8;
93 203         991 for my $bit_num ( 0 .. $bit_length ) {
94 12965 100       214921 last if $node >= $self->node_count;
95              
96 12762         349367 my $temp_bit = 0xFF & $address_bytes[ $bit_num >> 3 ];
97 12762         26667 my $bit = 1 & ( $temp_bit >> 7 - ( $bit_num % 8 ) );
98              
99 12762         29865 my ( $left_record, $right_record ) = $self->_read_node($node);
100              
101 12762 100       29937 $node = $bit ? $right_record : $left_record;
102              
103 12762         25362 if (DEBUG) {
104             $self->_debug_string( 'Bit #', $bit_length - $bit_num );
105             $self->_debug_string( 'Bit value', $bit );
106             $self->_debug_string( 'Record', $bit ? 'right' : 'left' );
107             $self->_debug_string( 'Record value', $node );
108             }
109             }
110              
111 203 100       8403 if ( $node == $self->node_count ) {
112 35         912 $self->_debug_message('Record is empty')
113             if DEBUG;
114 35         126 return;
115             }
116              
117 168 50       6875 if ( $node >= $self->node_count ) {
118 168         4614 $self->_debug_message('Record is a data pointer')
119             if DEBUG;
120 168         627 return $node;
121             }
122             }
123              
124             sub iterate_search_tree {
125 1     1 0 102 my $self = shift;
126 1         2 my $data_callback = shift;
127 1         2 my $node_callback = shift;
128              
129 1         3 my $node_num = 0;
130 1 50       25 my $ipnum = $self->ip_version() == 4 ? 0 : Math::BigInt->bzero();
131 1         23020 my $depth = 1;
132 1 50       30 my $max_depth = $self->ip_version() == 4 ? 32 : 128;
133              
134 1         45 $self->_iterate_search_tree(
135             $data_callback,
136             $node_callback,
137             $node_num,
138             $ipnum,
139             $depth,
140             $max_depth,
141             );
142             }
143              
144             ## no critic (Subroutines::ProhibitManyArgs)
145             sub _iterate_search_tree {
146 937     937   1711 my $self = shift;
147 937         1306 my $data_callback = shift;
148 937         1311 my $node_callback = shift;
149 937         1355 my $node_num = shift;
150 937         1480 my $ipnum = shift;
151 937         1252 my $depth = shift;
152 937         1277 my $max_depth = shift;
153              
154             ## no critic (TestingAndDebugging::ProhibitNoWarnings)
155 21     21   197 no warnings 'recursion';
  21         52  
  21         9376  
156             ## use critic
157              
158 937         2070 my @records = $self->_read_node($node_num);
159 937 50       2913 $node_callback->( $node_num, @records ) if $node_callback;
160              
161 937         2272 for my $idx ( 0 .. 1 ) {
162 1874         28733 my $value = $records[$idx];
163              
164             # We ignore empty branches of the search tree
165 1874 100       30420 next if $value == $self->node_count();
166              
167 965 50       39190 my $one = $self->ip_version() == 4 ? 1 : Math::BigInt->bone();
168 965 100       51112 $ipnum = $ipnum | ( $one << ( $max_depth - $depth ) ) if $idx;
169              
170 965 100       256870 if ( $value <= $self->node_count() ) {
    50          
171 936         27680 $self->_iterate_search_tree(
172             $data_callback,
173             $node_callback,
174             $value,
175             $ipnum,
176             $depth + 1,
177             $max_depth,
178             );
179             }
180             elsif ($data_callback) {
181 0         0 $data_callback->(
182             $ipnum, $depth,
183             $self->_get_entry_data($value)
184             );
185             }
186             }
187             }
188             ## use critic
189              
190             sub _get_entry_data {
191 168     168   322 my $self = shift;
192 168         298 my $offset = shift;
193              
194 168         2741 my $resolved = ( $offset - $self->node_count ) + $self->_search_tree_size;
195              
196 168 100       11412 confess q{The MaxMind DB file's search tree is corrupt}
197             if $resolved > $self->_data_source_size;
198              
199 167         1495 if (DEBUG) {
200             my $node_count = $self->node_count;
201             my $tree_size = $self->_search_tree_size;
202              
203             $self->_debug_string(
204             'Resolved data pointer',
205             "( $offset - $node_count ) + $tree_size = $resolved"
206             );
207             }
208              
209             # We only want the data from the decoder, not the offset where it was
210             # found.
211 167         2743 return scalar $self->_decoder->decode($resolved);
212             }
213              
214             sub _build_ipv4_start_node {
215 11     11   712 my $self = shift;
216              
217 11 50       180 return 0 unless $self->ip_version == 6;
218              
219 11         317 my $node_num = 0;
220              
221 11         44 for ( 1 ... 96 ) {
222 1024         28124 ($node_num) = $self->_read_node($node_num);
223 1024 100       17479 last if $node_num >= $self->node_count;
224             }
225              
226 11         474 return $node_num;
227             }
228              
229             1;