view release on metacpan or  search on metacpan

lib/Geo/IPfree.pm  view on Meta::CPAN

package Geo::IPfree;
use 5.006;
use strict;
use warnings;

use Carp qw();

require Exporter;
our @ISA = qw(Exporter);

our $VERSION = '1.160001';    # VERSION

# ABSTRACT: Geo::IPfree - Look up the country of an IPv4 address

our @EXPORT    = qw(LookUp LoadDB);
our @EXPORT_OK = @EXPORT;

my $DEFAULT_DB   = 'ipscountry.dat';
my $cache_expire = 5000;
my @baseX        = (
    0 .. 9,
    'A' .. 'Z',
    'a' .. 'z',
    split( m{}, q(.,;'"`<>{}[]=+-~*@#%$&!?) )
);

my ( %baseX, $base, $THIS, %countrys, $base0, $base1, $base2, $base3, $base4 );

{
    my $c = 0;
    %baseX = map { $_ => ( $c++ ) } @baseX;
    $base  = @baseX;
    $base0 = $base**0;
    $base1 = $base**1;
    $base2 = $base**2;
    $base3 = $base**3;
    $base4 = $base**4;

    my @data;
    while (<DATA>) {
        last if m{^__END__};
        chomp;
        push @data, split m{ }, $_, 2;
    }
    %countrys = @data;
}

sub new {
    my ( $class, $db_file ) = @_;

    if ( !defined $_[0] || $_[0] !~ /^[\w:]+$/ ) {
        $class   = 'Geo::IPfree';
        $db_file = $_[0];
    }

    my $this = bless( {}, $class );

    if ( !defined $db_file ) { $db_file = _find_db_file(); }

    $this->LoadDB($db_file);

    $this->Clean_Cache();
    $this->{cache} = 1;

    return $this;
}

sub get_all_countries {
    return {%countrys};    # copy
}

sub _find_db_file {
    my @locations = (
        qw(/usr/local/share /usr/local/share/GeoIPfree),
        map { $_, "$_/Geo" } @INC
    );

    # lastly, find where this module was loaded, and try that dir
    my ($lib) = ( $INC{'Geo/IPfree.pm'} =~ /^(.*?)[\\\/]+[^\\\/]+$/gs );
    push @locations, $lib;

    for my $file ( map { "$_/$DEFAULT_DB" } @locations ) {
        return $file if -e $file;
    }
}

sub LoadDB {
    my $this = shift;
    my ($db_file) = @_;

    if ( -d $db_file ) { $db_file .= "/$DEFAULT_DB"; }

    if ( !-s $db_file ) {
        Carp::croak("Can't load database, blank or not there: $db_file");
    }

    my $buffer = '';
    open( my $handler, '<', $db_file )
      || Carp::croak("Failed to open database file $db_file for read!");
    binmode($handler);
    $this->{dbfile} = $db_file;

    delete $this->{pos} if $this->{pos};