| 2 | 2 |
use strict;
|
| 3 | 3 |
use warnings;
|
| 4 | 4 |
|
| 5 | |
use Memoize;
|
| 6 | 5 |
use Carp qw();
|
| 7 | 6 |
|
| 8 | 7 |
require Exporter;
|
|
| 22 | 21 |
split( m{}, q(.,;'"`<>{}[]=+-~*@#%$&!?) )
|
| 23 | 22 |
);
|
| 24 | 23 |
|
| 25 | |
my ( %baseX, $base, $THIS, %countrys );
|
|
24 |
my ( %baseX, $base, $THIS, %countrys, $base0, $base1, $base2, $base3, $base4 );
|
| 26 | 25 |
|
| 27 | 26 |
{
|
| 28 | 27 |
my $c = 0;
|
| 29 | 28 |
%baseX = map { $_ => ( $c++ ) } @baseX;
|
| 30 | 29 |
$base = @baseX;
|
|
30 |
$base0 = $base**0;
|
|
31 |
$base1 = $base**1;
|
|
32 |
$base2 = $base**2;
|
|
33 |
$base3 = $base**3;
|
|
34 |
$base4 = $base**4;
|
| 31 | 35 |
|
| 32 | 36 |
my @data;
|
| 33 | 37 |
while ( <DATA> ) {
|
|
| 124 | 128 |
|
| 125 | 129 |
my ( $ip ) = @_;
|
| 126 | 130 |
|
| 127 | |
$ip =~ s/\.+/\./gs;
|
| 128 | |
$ip =~ s/^\.//;
|
| 129 | |
$ip =~ s/\.$//;
|
|
131 |
$ip =~ s/\.+/\./gs if index($ip,'..') > -1;
|
|
132 |
substr($ip,0,1,'') if substr($ip,0,1) eq '.';
|
|
133 |
chop $ip if substr($ip,-1) eq '.';
|
| 130 | 134 |
|
| 131 | 135 |
if ( $ip !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ ) {
|
| 132 | 136 |
$ip = nslookup( $ip );
|
|
| 150 | 154 |
if ( $ipnb <= $Key ) { $buf_pos = $this->{ pos }{ $Key }; last; }
|
| 151 | 155 |
}
|
| 152 | 156 |
|
| 153 | |
my ( $buffer, $country, $iprange );
|
|
157 |
my ( $buffer, $country, $iprange, $basex2 );
|
| 154 | 158 |
|
| 155 | 159 |
## Will use the DB in the memory:
|
| 156 | |
if ( $this->{ FASTER } ) {
|
| 157 | |
while ( $buf_pos < $this->{ DB_SIZE } ) {
|
| 158 | |
$buffer = substr( $this->{ DB }, $buf_pos, 7 );
|
| 159 | |
$country = substr( $buffer, 0, 2 );
|
| 160 | |
$iprange = baseX2dec( substr( $buffer, 2, 5 ) );
|
|
160 |
if ( $this->{FASTER} ) {
|
|
161 |
my $base_cache = $this->{'baseX2dec'} ||= {};
|
|
162 |
while ( $buf_pos < $this->{DB_SIZE} ) {
|
|
163 |
if ( $ipnb >= ( $base_cache->{ ( $basex2 = substr( $this->{DB}, $buf_pos + 2, 5 ) ) } ||= baseX2dec($basex2) ) ) {
|
|
164 |
$country = substr( $this->{DB}, $buf_pos, 2 );
|
|
165 |
last;
|
|
166 |
}
|
| 161 | 167 |
$buf_pos += 7;
|
| 162 | |
last if $ipnb >= $iprange;
|
| 163 | 168 |
}
|
|
169 |
$country ||= substr( $this->{DB}, $buf_pos-7, 2 );
|
| 164 | 170 |
}
|
| 165 | 171 |
## Will read the DB in the disk:
|
| 166 | 172 |
else {
|
| 167 | |
seek( $this->{ handler }, 0, 0 )
|
| 168 | |
if $] < 5.006001; ## Fix bug on Perl 5.6.0
|
| 169 | |
seek( $this->{ handler }, $buf_pos + $this->{ start }, 0 );
|
| 170 | |
while ( read( $this->{ handler }, $buffer, 7 ) ) {
|
| 171 | |
$country = substr( $buffer, 0, 2 );
|
| 172 | |
$iprange = baseX2dec( substr( $buffer, 2 ) );
|
| 173 | |
last if $ipnb >= $iprange;
|
|
173 |
seek( $this->{handler}, 0, 0 )
|
|
174 |
if $] < 5.006001; ## Fix bug on Perl 5.6.0
|
|
175 |
seek( $this->{handler}, $buf_pos + $this->{start}, 0 );
|
|
176 |
while ( read( $this->{handler}, $buffer, 7 ) ) {
|
|
177 |
if ( $ipnb >= baseX2dec( substr( $buffer, 2 ) ) ) {
|
|
178 |
$country = substr( $buffer, 0, 2 );
|
|
179 |
last;
|
|
180 |
}
|
| 174 | 181 |
}
|
| 175 | 182 |
}
|
| 176 | 183 |
|
|
| 198 | 205 |
|
| 199 | 206 |
$this->{ DB } = do { local $/; <$handler>; };
|
| 200 | 207 |
$this->{ DB_SIZE } = length( $this->{ DB } );
|
| 201 | |
|
| 202 | |
memoize( 'dec2baseX' );
|
| 203 | |
memoize( 'baseX2dec' );
|
| 204 | |
|
| 205 | 208 |
$this->{ FASTER } = 1;
|
| 206 | 209 |
}
|
| 207 | 210 |
|
|
| 209 | 212 |
my $this = shift;
|
| 210 | 213 |
$this->{ CACHE_COUNT } = 0;
|
| 211 | 214 |
delete $this->{ CACHE };
|
|
215 |
delete $this->{'baseX2dec'};
|
| 212 | 216 |
return 1;
|
| 213 | 217 |
}
|
| 214 | 218 |
|
|
| 261 | 265 |
}
|
| 262 | 266 |
|
| 263 | 267 |
sub baseX2dec {
|
| 264 | |
my ( $input ) = @_;
|
| 265 | |
|
| 266 | |
my @digits = reverse split( '', $input );
|
| 267 | |
my $dec = 0;
|
| 268 | |
|
| 269 | |
foreach ( 0 .. @digits - 1 ) {
|
| 270 | |
$dec += $baseX{ $digits[ $_ ] } * ( $base**$_ );
|
| 271 | |
}
|
| 272 | |
|
| 273 | |
return $dec;
|
|
268 |
my $string = reverse $_[0];
|
|
269 |
my $length = length $string;
|
|
270 |
return #
|
|
271 |
(
|
|
272 |
0 + ( $length > 4 ? ( $baseX{ substr( $string, 4, 1 ) } * $base4 ) : 0 ) + #
|
|
273 |
( $length > 3 ? ( $baseX{ substr( $string, 3, 1 ) } * $base3 ) : 0 ) + #
|
|
274 |
( $length > 2 ? ( $baseX{ substr( $string, 2, 1 ) } * $base2 ) : 0 ) + #
|
|
275 |
( $length > 1 ? ( $baseX{ substr( $string, 1, 1 ) } * $base1 ) : 0 ) + #
|
|
276 |
( $length ? ( $baseX{ substr( $string, 0, 1 ) } * $base0 ) : 0 ) #
|
|
277 |
); #
|
| 274 | 278 |
}
|
| 275 | 279 |
|
| 276 | 280 |
1;
|