From c1ec59a52d0df7edaba1ef19ddb89eaec988343c Mon Sep 17 00:00:00 2001 From: Silvano Cerza Date: Wed, 19 Nov 2025 16:24:22 +0100 Subject: [PATCH] Add support for Core bundle --- Geo-IPinfo/MANIFEST | 3 + Geo-IPinfo/lib/Geo/DetailsCore.pm | 149 ++++++++++++++++ Geo-IPinfo/lib/Geo/IPinfoCore.pm | 273 ++++++++++++++++++++++++++++++ Geo-IPinfo/t/03-usage-core.t | 63 +++++++ 4 files changed, 488 insertions(+) create mode 100644 Geo-IPinfo/lib/Geo/DetailsCore.pm create mode 100644 Geo-IPinfo/lib/Geo/IPinfoCore.pm create mode 100644 Geo-IPinfo/t/03-usage-core.t diff --git a/Geo-IPinfo/MANIFEST b/Geo-IPinfo/MANIFEST index 239d0a3..fdea4b1 100644 --- a/Geo-IPinfo/MANIFEST +++ b/Geo-IPinfo/MANIFEST @@ -1,14 +1,17 @@ Changes lib/Geo/IPinfo.pm lib/Geo/IPinfoLite.pm +lib/Geo/IPinfoCore.pm lib/Geo/Details.pm lib/Geo/DetailsLite.pm +lib/Geo/DetailsCore.pm Makefile.PL MANIFEST This list of files ignore.txt t/00-load.t t/01-usage.t t/02-usage-lite.t +t/03-usage-core.t t/cache-hit.t t/manifest.t t/pod-coverage.t diff --git a/Geo-IPinfo/lib/Geo/DetailsCore.pm b/Geo-IPinfo/lib/Geo/DetailsCore.pm new file mode 100644 index 0000000..c9ddeaf --- /dev/null +++ b/Geo-IPinfo/lib/Geo/DetailsCore.pm @@ -0,0 +1,149 @@ +package Geo::DetailsCore; + +use 5.006; +use strict; +use warnings; + +# Helper package for Geo data +package Geo::DetailsCore::Geo { + use strict; + use warnings; + + sub new { + my $class = shift; + my $data = shift || {}; + bless $data, $class; + return $data; + } + + sub city { return $_[0]->{city}; } + sub region { return $_[0]->{region}; } + sub region_code { return $_[0]->{region_code}; } + sub country { return $_[0]->{country}; } + sub country_code { return $_[0]->{country_code}; } + sub continent { return $_[0]->{continent}; } + sub continent_code { return $_[0]->{continent_code}; } + sub latitude { return $_[0]->{latitude}; } + sub longitude { return $_[0]->{longitude}; } + sub timezone { return $_[0]->{timezone}; } + sub postal_code { return $_[0]->{postal_code}; } + + # Enriched fields + sub country_name { return $_[0]->{country_name}; } + sub is_eu { return $_[0]->{is_eu}; } + sub country_flag { return $_[0]->{country_flag}; } + sub country_flag_url { return $_[0]->{country_flag_url}; } + sub country_currency { return $_[0]->{country_currency}; } + sub continent_info { return $_[0]->{continent_info}; } +} + +# Helper package for AS data +package Geo::DetailsCore::AS { + use strict; + use warnings; + + sub new { + my $class = shift; + my $data = shift || {}; + bless $data, $class; + return $data; + } + + sub asn { return $_[0]->{asn}; } + sub name { return $_[0]->{name}; } + sub domain { return $_[0]->{domain}; } + sub type { return $_[0]->{type}; } +} + +# Main package +package Geo::DetailsCore; + +sub new { + my $class = shift; + my $data = shift; + my $key = shift // ''; + + # If $data is a hash reference, process and bless it + if ( ref($data) eq 'HASH' ) { + # Convert nested geo and as to blessed objects + if ( exists $data->{geo} && ref($data->{geo}) eq 'HASH' ) { + $data->{geo} = Geo::DetailsCore::Geo->new($data->{geo}); + } + if ( exists $data->{as} && ref($data->{as}) eq 'HASH' ) { + $data->{as} = Geo::DetailsCore::AS->new($data->{as}); + } + + bless $data, $class; + return $data; + } + + # If $data is a plain string, create a new hash reference + my $self = { $key => $data }; + bless $self, $class; + return $self; +} + +sub TO_JSON { + my ($self) = @_; + return {%$self}; +} + +sub ip { return $_[0]->{ip}; } +sub geo { return $_[0]->{geo}; } +sub as { return $_[0]->{as}; } +sub is_anonymous { return $_[0]->{is_anonymous}; } +sub is_anycast { return $_[0]->{is_anycast}; } +sub is_hosting { return $_[0]->{is_hosting}; } +sub is_mobile { return $_[0]->{is_mobile}; } +sub is_satellite { return $_[0]->{is_satellite}; } +sub bogon { return $_[0]->{bogon}; } + +sub all { + return $_[0]; +} + +1; +__END__ + +=head1 NAME + +Geo::DetailsCore - Module to represent details of an IP returned by the Core API + +=head1 SYNOPSIS + + use Geo::DetailsCore; + + my $data = { + ip => '8.8.8.8', + geo => { + city => 'Mountain View', + country => 'United States', + country_code => 'US', + }, + as => { + asn => 'AS15169', + name => 'Google LLC', + }, + is_anycast => 1, + }; + + my $details = Geo::DetailsCore->new($data); + print $details->ip; # Output: 8.8.8.8 + print $details->geo->city; # Output: Mountain View + print $details->as->name; # Output: Google LLC + +=head1 DESCRIPTION + +Geo::DetailsCore represents details of an IP returned by the IPinfo Core API. + +=head1 AUTHOR + +IPinfo + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2025 IPinfo + +Licensed under the Apache License, Version 2.0. + +=cut diff --git a/Geo-IPinfo/lib/Geo/IPinfoCore.pm b/Geo-IPinfo/lib/Geo/IPinfoCore.pm new file mode 100644 index 0000000..caf5e10 --- /dev/null +++ b/Geo-IPinfo/lib/Geo/IPinfoCore.pm @@ -0,0 +1,273 @@ +package Geo::IPinfoCore; + +use 5.006; +use strict; +use warnings; +use Cache::LRU; +use LWP::UserAgent; +use HTTP::Headers; +use JSON; +use Geo::DetailsCore; +use Net::CIDR; +use Net::CIDR::Set; + +our $VERSION = '3.1.2'; +use constant DEFAULT_CACHE_MAX_SIZE => 4096; +use constant DEFAULT_CACHE_TTL => 86_400; +use constant DEFAULT_TIMEOUT => 2; +use constant HTTP_TOO_MANY_REQUEST => 429; + +my $base_url = 'https://api.ipinfo.io/lookup/'; + +my @ip4_bogon_networks = ( + '0.0.0.0/8', '10.0.0.0/8', '100.64.0.0/10', '127.0.0.0/8', + '169.254.0.0/16', '172.16.0.0/12', '192.0.0.0/24', '192.0.2.0/24', + '192.168.0.0/16', '198.18.0.0/15', '198.51.100.0/24', + '203.0.113.0/24', '224.0.0.0/4', '240.0.0.0/4', '255.255.255.255/32', +); + +my @ip6_bogon_networks = ( + '::/128', '::1/128', '::ffff:0:0/96', '::/96', + '100::/64', '2001:10::/28', '2001:db8::/32', 'fc00::/7', + 'fe80::/10', 'fec0::/10', 'ff00::/8', '2002::/24', + '2002:a00::/24', '2002:7f00::/24', '2002:a9fe::/32', '2002:ac10::/28', + '2002:c000::/40', '2002:c000:200::/40', '2002:c0a8::/32', + '2002:c612::/31', '2002:c633:6400::/40', '2002:cb00:7100::/40', + '2002:e000::/20', '2002:f000::/20', '2002:ffff:ffff::/48', + '2001::/40', '2001:0:a00::/40', '2001:0:7f00::/40', + '2001:0:a9fe::/48', '2001:0:ac10::/44', '2001:0:c000::/56', + '2001:0:c000:200::/56', '2001:0:c0a8::/48', '2001:0:c612::/47', + '2001:0:c633:6400::/56', '2001:0:cb00:7100::/56', '2001:0:e000::/36', + '2001:0:f000::/36', '2001:0:ffff:ffff::/64', +); + +sub new { + my ( $class, %options ) = @_; + + my $token = defined $options{token} ? $options{token} : ''; + + my $cache_maxsize = + defined $options{cache_maxsize} + ? $options{cache_maxsize} + : DEFAULT_CACHE_MAX_SIZE; + + my $cache_ttl = + defined $options{cache_ttl} + ? $options{cache_ttl} + : DEFAULT_CACHE_TTL; + + my $timeout = + defined $options{timeout} + ? $options{timeout} + : DEFAULT_TIMEOUT; + + my $header = HTTP::Headers->new(); + $header->header( 'User-Agent' => 'IPinfoClient/Perl/3.1.2' ); + $header->header( 'Accept' => 'application/json' ); + $header->header( 'Content-Type' => 'application/json' ); + + if ($token) { + $header->header( 'Authorization' => 'Bearer ' . $token ); + } + + my $ua = LWP::UserAgent->new( + timeout => $timeout, + show_progress => 0, + ); + + $ua->default_headers($header); + + my $cache; + if ( defined $options{cache} ) { + $cache = $options{cache}; + } + else { + $cache = _build_cache( __PACKAGE__, cache_maxsize => $cache_maxsize, cache_ttl => $cache_ttl ); + } + + my $self = { + token => $token, + base_url => $base_url, + ua => $ua, + cache => $cache, + cache_ttl => $cache_ttl, + message => '', + }; + + return bless $self, $class; +} + +sub info { + my ( $self, $ip ) = @_; + + return $self->_get_info( $ip, ); +} + + +sub _get_info { + my ( $self, $ip ) = @_; + + $ip = defined $ip ? $ip : ''; + + if ( $ip ne '' ) { + my $validated_ip = Net::CIDR::cidrvalidate($ip); + if ( !defined $validated_ip ) { + $self->{message} = 'Invalid IP address'; + return undef; + } + } + + my ( $info, $message ) = $self->_lookup_info( $ip ); + $self->{message} = $message; + return $info if eval { $info->isa('Geo::DetailsCore') }; + + return defined $info ? Geo::DetailsCore->new( $info ) : undef; +} + +sub _lookup_info { + my ( $self, $ip ) = @_; + + # checking bogon IP and returning response locally. + if ( $ip ne '' ) { + if ( _is_bogon($ip) ) { + my $details = {}; + $details->{ip} = $ip; + $details->{bogon} = "True"; + return ( $details, '' ); + } + } + + my ( $info, $message ); + my $cache_key = 'core_' . $ip; + + if ( !defined $self->{cache} ) { + ( $info, $message ) = $self->_lookup_info_from_source($ip); + } + else { + ( $info, $message ) = $self->_lookup_info_from_cache( $ip, $cache_key ); + + if ( !defined $info ) { + ( $info, $message ) = $self->_lookup_info_from_source($ip); + + if ( defined $info && ref $info eq 'HASH' && !exists $info->{bogon} ) { + $self->{cache}->set( $cache_key => $info, $self->{cache_ttl} ); + } + } + } + + return ( $info, $message ); +} + +sub _lookup_info_from_cache { + my ( $self, $ip, $cache_key ) = @_; + + my $info = $self->{cache}->get($cache_key); + + if ( !defined $info ) { + return ( undef, '' ); + } + + return ( $info, '' ); +} + +sub _lookup_info_from_source { + my ( $self, $ip ) = @_; + + my $url = ''; + if ( $ip ) { + $url = $self->{base_url} . $ip; + } else { + $url = $self->{base_url} . "me"; + } + + my $response = $self->{ua}->get($url); + + if ( $response->is_success ) { + + my $content_type = $response->header('Content-Type') || ''; + my $info; + + if ( $content_type =~ m{application/json}i ) { + eval { $info = from_json( $response->decoded_content ); }; + if ($@) { + return ( undef, 'Error parsing JSON response.' ); + } + } + else { + $info = $response->decoded_content; + chomp($info); + } + + return ( $info, '' ); + } + if ( $response->code == HTTP_TOO_MANY_REQUEST ) { + return ( undef, 'Your monthly request quota has been exceeded.' ); + } + + return ( undef, $response->status_line ); +} + +sub _build_cache { + my ( $pkg, %options ) = @_; + + my $cache_maxsize = defined $options{cache_maxsize} ? $options{cache_maxsize} : DEFAULT_CACHE_MAX_SIZE; + my $cache_ttl = defined $options{cache_ttl} ? $options{cache_ttl} : DEFAULT_CACHE_TTL; + + my $cache = Cache::LRU->new( size => $cache_maxsize ); + + return $cache; +} + +sub _is_bogon { + my $ip = shift; + + my $ip_is_bogon = 0; + + if ( $ip =~ /:/ ) { # IPv6 address + my $ip6_bogon_cidr_set = Net::CIDR::Set->new(); + $ip6_bogon_cidr_set->add($_) foreach (@ip6_bogon_networks); + $ip_is_bogon = $ip6_bogon_cidr_set->contains($ip); + } + else { # IPv4 address + my $ip4_bogon_cidr_set = Net::CIDR::Set->new(); + $ip4_bogon_cidr_set->add($_) foreach (@ip4_bogon_networks); + $ip_is_bogon = $ip4_bogon_cidr_set->contains($ip); + } + + return $ip_is_bogon; +} + +1; + +__END__ + +=head1 NAME + +Geo::IPinfoCore - Perl module for IPinfo Core API + +=head1 SYNOPSIS + + use Geo::IPinfoCore; + + my $ipinfo = Geo::IPinfoCore->new(token => 'YOUR_TOKEN'); + my $details = $ipinfo->info('8.8.8.8'); + + print "IP: " . $details->ip . "\n"; + print "City: " . $details->geo->city . "\n"; + print "Country: " . $details->geo->country . "\n"; + +=head1 DESCRIPTION + +Geo::IPinfoCore provides access to the IPinfo Core API for IP address lookups. + +=head1 AUTHOR + +IPinfo + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2025 IPinfo + +Licensed under the Apache License, Version 2.0. + +=cut diff --git a/Geo-IPinfo/t/03-usage-core.t b/Geo-IPinfo/t/03-usage-core.t new file mode 100644 index 0000000..d2bc4f1 --- /dev/null +++ b/Geo-IPinfo/t/03-usage-core.t @@ -0,0 +1,63 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; + +if ( $ENV{RELEASE_TESTING} ) { + plan tests => 30; +} +else { + plan( skip_all => "Basic usage tests not required for installation" ); +} + +use_ok('Geo::IPinfoCore'); + +my $ip; + +$ip = Geo::IPinfoCore->new( token => $ENV{IPINFO_TOKEN} ); +isa_ok( $ip, "Geo::IPinfoCore", '$ip' ); + +ok($ip->info(), "info() works with no IP"); + +ok( $ip->info("8.8.8.8"), "info() return an object when querying a valid IP" ); + +is( $ip->info("1000.1000.1.1"), + undef, "info() return undef when querying an invalid IP" ); + +# Test 8.8.8.8 +my $details = $ip->info( '8.8.8.8' ); +ok( $details, "Got details for 8.8.8.8" ); +is( $details->ip, "8.8.8.8", "IP field is correct" ); + +# Test geo fields +ok( $details->geo, "geo object exists" ); +is( $details->geo->city, "Mountain View", "City is correct" ); +is( $details->geo->region, "California", "Region is correct" ); +is( $details->geo->region_code, "CA", "Region code is correct" ); +is( $details->geo->country, "United States", "Country is correct" ); +is( $details->geo->country_code, "US", "Country code is correct" ); +is( $details->geo->continent, "North America", "Continent is correct" ); +is( $details->geo->continent_code, "NA", "Continent code is correct" ); +ok( defined $details->geo->latitude, "Latitude is defined" ); +ok( defined $details->geo->longitude, "Longitude is defined" ); +is( $details->geo->timezone, "America/Los_Angeles", "Timezone is correct" ); +is( $details->geo->postal_code, "94043", "Postal code is correct" ); + +# Test AS fields +ok( $details->as, "as object exists" ); +is( $details->as->asn, "AS15169", "ASN is correct" ); +is( $details->as->name, "Google LLC", "AS name is correct" ); +is( $details->as->domain, "google.com", "AS domain is correct" ); +is( $details->as->type, "hosting", "AS type is correct" ); + +# Test network flags +ok( defined $details->is_anonymous, "is_anonymous is defined" ); +ok( defined $details->is_anycast, "is_anycast is defined" ); +ok( defined $details->is_hosting, "is_hosting is defined" ); +ok( defined $details->is_mobile, "is_mobile is defined" ); +ok( defined $details->is_satellite, "is_satellite is defined" ); + +# Test bogon +my $bogon_details = $ip->info( '127.0.0.1' ); +ok( $bogon_details->bogon, "Bogon IP detected" );