view release on metacpan or  search on metacpan

lib/CCCP/LiveMX.pm  view on Meta::CPAN

package CCCP::LiveMX;

use strict;
use warnings;

our $VERSION = '0.01';

# from Mail::CheckUser, I use only $Mail::CheckUser::NXDOMAIN
use Mail::CheckUser qw();
use Net::DNS;
use Net::Ping 2.24;

=head1 NAME

CCCP::LiveMX

=head1 DESCRIPTION

Getting a ip-list of living MX-records for hostname

=head1 SYNOPSIS

    use CCCP::LiveMX;
    
    my $lmx = CCCP::LiveMX->check_host('example.org');
    if ($lmx->success) {
        my @live_ip = $lmx->live_ip;
    } else {
        print $lmx->error,"\n";
        my @not_ping_ip = $lmx->not_ping;
        my @not_ask_ip  = $lmx->not_ask;
    }
    
=head1 PACKAGE VARIABLES

=head2 $CCCP::LiveMX::timeout

Timeout for ping, resolve and another.
By default 5 sec.

=head1 METHODS

=cut

$CCCP::LiveMX::timeout = 5;

my $resolver;
my $ping;

=head2 check_host($host_name)

Checking MX records for C<$host_name> and return instance.

=cut
sub check_host {
    my ($class, $host) = @_;
    
    my $self = bless {
        error => undef,
        mx => {}
    }, $class;
    
    # Net::DNS::Resolver as a singletone
    $resolver ||= Net::DNS::Resolver->new();
    
    # Net::Ping as a singletone
    unless ($ping) {
        $ping = Net::Ping->new("syn", $CCCP::LiveMX::timeout);
        $ping->{port_num} = getservbyname("smtp", "tcp");
        $ping->service_check(1);
    };
    
    # getting mx-records
    $resolver->udp_timeout($CCCP::LiveMX::timeout);
    my @mx = mx($resolver, $host);
    unless (@mx) {
        # if the mx record is not found, try to check the hostname as a mail-server
        $resolver->udp_timeout($CCCP::LiveMX::timeout);
        my $res = $resolver->search($host, 'A');
        if ($res) {
            my $ip;
            foreach my $rr ($res->answer) {
                  if ($rr->type eq "A") {
                    $ip = $rr->address;
                    last;
                  } elsif ($rr->type eq "CNAME") {
                    $ip = $rr->cname;
                  } else {
                    # should never happen!
                    $ip = "";
                  }
            }
            if ($Mail::CheckUser::NXDOMAIN->{lc $ip}) {
                $self->error('Wildcard gTLD: '.$host.' ('.(lc $ip || '').')');
                return $self;
            }
            $self->_mx_servers($host,0);
        } else {