view release on metacpan or  search on metacpan

lib/DNS/Robot.pm  view on Meta::CPAN

package DNS::Robot;

use strict;
use warnings;

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

our $VERSION = '0.01';

sub new {
    my ($class, %args) = @_;
    my $self = bless {
        base_url   => $args{base_url}   || 'https://dnsrobot.net/api',
        user_agent => $args{user_agent} || "DNS-Robot-Perl/$VERSION",
        timeout    => $args{timeout}    || 30,
    }, $class;
    $self->{http} = HTTP::Tiny->new(
        agent   => $self->{user_agent},
        timeout => $self->{timeout},
    );
    return $self;
}

# ── Internal helpers ──

sub _post {
    my ($self, $endpoint, $payload) = @_;
    my $url  = "$self->{base_url}/$endpoint";
    my $body = encode_json($payload);
    my $res  = $self->{http}->request('POST', $url, {
        headers => { 'Content-Type' => 'application/json' },
        content => $body,
    });
    croak "DNS::Robot: HTTP $res->{status} from $endpoint"
        unless $res->{success};
    return decode_json($res->{content});
}

sub _get {
    my ($self, $endpoint, $params) = @_;
    my $query = join '&', map { "$_=" . _uri_encode($params->{$_}) } sort keys %$params;
    my $url   = "$self->{base_url}/$endpoint?$query";
    my $res   = $self->{http}->request('GET', $url);
    croak "DNS::Robot: HTTP $res->{status} from $endpoint"
        unless $res->{success};
    return decode_json($res->{content});
}

sub _uri_encode {
    my ($str) = @_;
    $str =~ s/([^A-Za-z0-9\-._~])/sprintf("%%%02X", ord($1))/ge;
    return $str;
}

# ── Public methods ──

sub dns_lookup {
    my ($self, %args) = @_;
    croak "dns_lookup: 'domain' is required" unless $args{domain};
    return $self->_post('dns-query', {
        domain     => $args{domain},
        recordType => $args{record_type} || 'A',
        dnsServer  => $args{dns_server}  || '8.8.8.8',
    });
}

sub whois_lookup {
    my ($self, %args) = @_;
    croak "whois_lookup: 'domain' is required" unless $args{domain};
    return $self->_post('whois', { domain => $args{domain} });
}

sub ssl_check {
    my ($self, %args) = @_;
    croak "ssl_check: 'domain' is required" unless $args{domain};
    return $self->_post('ssl-certificate', { domain => $args{domain} });
}

sub spf_check {
    my ($self, %args) = @_;
    croak "spf_check: 'domain' is required" unless $args{domain};
    return $self->_post('spf-checker', { domain => $args{domain} });
}

sub dkim_check {
    my ($self, %args) = @_;
    croak "dkim_check: 'domain' is required" unless $args{domain};
    my $payload = { domain => $args{domain} };
    $payload->{selector} = $args{selector} if $args{selector};
    return $self->_post('dkim-checker', $payload);
}

sub dmarc_check {
    my ($self, %args) = @_;
    croak "dmarc_check: 'domain' is required" unless $args{domain};
    return $self->_post('dmarc-checker', { domain => $args{domain} });
}

sub mx_lookup {
    my ($self, %args) = @_;
    croak "mx_lookup: 'domain' is required" unless $args{domain};
    return $self->_post('mx-lookup', { domain => $args{domain} });
}