IP::Country::DB_File - IP to country translation based on DB_File

 use IP::Country::DB_File;

 my $ipcc = IP::Country::DB_File->new();
 $ipcc->inet_atocc('1.2.3.4');
 $ipcc->inet_atocc('host.example.com');

 my $ipcc = IP::Country::DB_File->new([ $db_file ]);

 $ipcc->inet_atocc($string);

 $ipcc->inet_ntocc($string);

 $ipcc->db_time();

package IP::Country::DB_File;
BEGIN {
  $IP::Country::DB_File::VERSION = '2.01';
}
use strict;

# ABSTRACT: IP to country translation based on DB_File

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

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 = $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 inet_atocc {
    my ($this, $ip) = @_;
    
    my $addr = Socket::inet_aton($ip);
    return undef unless defined($addr);
    
    my ($key, $data);
    $this->{db}->seq($key = $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 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__