File Coverage

blib/lib/IP/Country/DB_File.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package IP::Country::DB_File;
$IP::Country::DB_File::VERSION = '3.03';
use strict;
use warnings;

# ABSTRACT: IPv4 and IPv6 to country translation using DB_File

use DB_File ();
use Fcntl ();
use Socket 1.94 ();

sub new {
    my ($class, $db_file) = @_;
    $db_file = 'ipcc.db' unless defined($db_file);

    my $this = {};
    my %db;

    $this->{db} = tie(%db, 'DB_File', $db_file, Fcntl::O_RDONLY, 0666,
                      $DB_File::DB_BTREE)
        or die("Can't open database $db_file: $!");

    return bless($this, $class);
}

sub inet_ntocc {
    my ($this, $addr) = @_;

    my ($key, $data);
    $this->{db}->seq($key = "4$addr", $data, DB_File::R_CURSOR()) == 0
        or return undef;
    # Verify that key starts with '4' and isn't from IPv6 range.
    return undef if ord($key) != 52;

    my $start = substr($data, 0, 4);
    my $cc    = substr($data, 4, 2);

    return $addr ge $start ? $cc : undef;
}

sub inet_atocc {
    my ($this, $ip) = @_;

    my $addr = Socket::inet_aton($ip);
    return undef unless defined($addr);

    my ($key, $data);
    $this->{db}->seq($key = "4$addr", $data, DB_File::R_CURSOR()) == 0
        or return undef;
    # Verify that key starts with '4' and isn't from IPv6 range.
    return undef if ord($key) != 52;

    my $start = substr($data, 0, 4);
    my $cc    = substr($data, 4, 2);

    return $addr ge $start ? $cc : undef;
}

sub inet6_ntocc {
    my ($this, $addr) = @_;

    $addr = substr($addr, 0, 8);

    my ($key, $data);
    $this->{db}->seq($key = "6$addr", $data, DB_File::R_CURSOR()) == 0
        or return undef;
    my $start = substr($data, 0, 4);
    my $cc    = substr($data, 4, 2);

    return $addr ge $start ? $cc : undef;
}

sub inet6_atocc {
    my ($this, $host) = @_;

    my ($err, $result) = Socket::getaddrinfo($host, undef, {
        family   => Socket::AF_INET6,
        socktype => Socket::SOCK_STREAM,
    });
    return undef if $err || !$result;
    my (undef, $addr) = Socket::unpack_sockaddr_in6($result->{addr});

    $addr = substr($addr, 0, 8);

    my ($key, $data);
    $this->{db}->seq($key = "6$addr", $data, DB_File::R_CURSOR()) == 0
        or return undef;
    my $start = substr($data, 0, 8);
    my $cc    = substr($data, 8, 2);

    return $addr ge $start ? $cc : undef;
}

sub db_time {
    my $this = shift;

    my $file;
    my $fd = $this->{db}->fd();
    open($file, "<&$fd")
        or die("Can't dup DB file descriptor: $!\n");
    my @stat = stat($file)
        or die("Can't stat DB file descriptor: $!\n");
    close($file);

    return $stat[9]; # mtime
}

1;

__END__