File Coverage

blib/lib/Net/IPData.pm

Criterion	Covered	Total	%
statement	94	114	82.4
branch	32	36	88.8
condition	16	26	61.5
subroutine	23	30	76.6
pod	17	17	100.0
total	182	223	81.6

package Net::IPData;

use strict;
use warnings;
use 5.010001;

our $VERSION = '1.0.0';

use HTTP::Tiny;
use JSON::PP qw(encode_json decode_json);
use Carp qw(croak);
use Scalar::Util qw(blessed);

# API base URLs
use constant {
    BASE_URL    => 'https://api.ipdata.co',
    EU_BASE_URL => 'https://eu-api.ipdata.co',
    MAX_BULK    => 100,
};

# Valid top-level fields for filtering
my %VALID_FIELDS = map { $_ => 1 } qw(
    ip is_eu city region region_code region_type
    country_name country_code continent_name continent_code
    latitude longitude postal calling_code flag
    emoji_flag emoji_unicode asn company carrier
    languages currency time_zone threat count status message
);

# Valid single-field path lookups (fields accessible via /{ip}/{field})
my %PATH_FIELDS = map { $_ => 1 } qw(
    ip is_eu city region region_code region_type
    country_name country_code continent_name continent_code
    latitude longitude postal calling_code flag
    emoji_flag emoji_unicode asn carrier languages
    currency time_zone threat
);

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

    my $api_key = $args{api_key}
        or croak 'Required parameter "api_key" is missing';

    my $base_url = $args{base_url};
    if ($args{eu} && !$base_url) {
        $base_url = EU_BASE_URL;
    }
    $base_url //= BASE_URL;
    $base_url =~ s{/+$}{};  # strip trailing slashes

    my $timeout = $args{timeout} // 30;

    my $ua = HTTP::Tiny->new(
        agent           => "Net-IPData-Perl/$VERSION",
        timeout         => $timeout,
        default_headers => {
            'Accept'       => 'application/json',
            'Content-Type' => 'application/json',
        },
    );

    return bless {
        api_key  => $api_key,
        base_url => $base_url,
        ua       => $ua,
        timeout  => $timeout,
    }, $class;
}

# --- Public Methods ---

sub lookup {
    my ($self, $ip, %opts) = @_;

    my $path = defined $ip && length $ip ? "/$ip" : '';
    my @params;

    if (my $fields = $opts{fields}) {
        my @field_list = ref $fields eq 'ARRAY' ? @$fields : split(/\s*,\s*/, $fields);
        _validate_fields(\@field_list);
        push @params, 'fields=' . join(',', @field_list);
    }

    my $url = $self->_build_url($path, @params);
    return $self->_get($url);
}

sub lookup_mine {
    my ($self, %opts) = @_;
    return $self->lookup(undef, %opts);
}

sub lookup_field {
    my ($self, $ip, $field) = @_;

    croak 'Required parameter "ip" is missing'    unless defined $ip && length $ip;
    croak 'Required parameter "field" is missing'  unless defined $field && length $field;
    croak "Invalid field: $field" unless $PATH_FIELDS{$field};

    my $url = $self->_build_url("/$ip/$field");
    return $self->_get($url);
}

sub bulk {
    my ($self, $ips, %opts) = @_;

    croak 'Required parameter "ips" must be an array reference'
        unless ref $ips eq 'ARRAY';
    croak 'Bulk lookup supports a maximum of ' . MAX_BULK . ' IP addresses'
        if @$ips > MAX_BULK;
    croak 'Bulk lookup requires at least one IP address'
        if @$ips == 0;

    my @params;
    if (my $fields = $opts{fields}) {
        my @field_list = ref $fields eq 'ARRAY' ? @$fields : split(/\s*,\s*/, $fields);
        _validate_fields(\@field_list);
        push @params, 'fields=' . join(',', @field_list);
    }

    my $url = $self->_build_url('/bulk', @params);
    return $self->_post($url, $ips);
}

sub asn {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'asn');
}

sub threat {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'threat');
}

sub carrier {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'carrier');
}

sub currency {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'currency');
}

sub time_zone {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'time_zone');
}

sub languages {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'languages');
}

sub country_name {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'country_name');
}

sub country_code {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'country_code');
}

sub is_eu {
    my ($self, $ip) = @_;
    return $self->lookup_field($ip, 'is_eu');
}

# --- Accessors ---

sub api_key  { return $_[0]->{api_key} }
sub base_url { return $_[0]->{base_url} }
sub timeout  { return $_[0]->{timeout} }

# --- Private Methods ---

sub _build_url {
    my ($self, $path, @params) = @_;

    unshift @params, 'api-key=' . $self->{api_key};
    my $query = join('&', @params);

    return $self->{base_url} . ($path // '') . '?' . $query;
}

sub _get {
    my ($self, $url) = @_;

    my $response = $self->{ua}->get($url);
    return $self->_handle_response($response);
}

sub _post {
    my ($self, $url, $data) = @_;

    my $body = encode_json($data);
    my $response = $self->{ua}->post($url, { content => $body });
    return $self->_handle_response($response);
}

sub _handle_response {
    my ($self, $response) = @_;

    my $status  = $response->{status};
    my $content = $response->{content} // '';

    # Network-level failures from HTTP::Tiny (status 599)
    if ($status == 599) {
        croak "Network error: $content";
    }

    # Try to decode JSON
    my $data;
    eval { $data = decode_json($content); };
    if ($@) {
        # Non-JSON response (e.g., single field value like country_name)
        # The API returns bare strings for single-field path lookups
        $content =~ s/^\s+|\s+$//g;    # trim whitespace
        $content =~ s/^"|"$//g;        # strip surrounding quotes

        if ($status >= 200 && $status < 300) {
            return $content;
        }
        croak "HTTP $status: $content";
    }

    # API error responses include a "message" field
    if ($status >= 400) {
        my $message = $data->{message} // "HTTP $status error";
        croak "API error ($status): $message";
    }

    return $data;
}

sub _validate_fields {
    my ($fields) = @_;
    for my $f (@$fields) {
        croak "Invalid field: $f" unless $VALID_FIELDS{$f};
    }
}

1;

__END__