#!/usr/bin/perl -w

use strict;

use Net::DNS;

use Net::ParseWhois;

die "Usage: whois_domain.pl DOMAIN(S)\n" unless @ARGV;

while (@ARGV)
{
    my $domain = shift;

    my $soa_domain;

    FIND_SOA: {
        my $res = new Net::DNS::Resolver;

        my $q = $res->send($domain, "SOA");

        for my $sec (qw(answer authority))
        {
            my $meth = $q->can($sec) or next;

            for my $rec ($meth->($q))
            {
                next unless $rec->isa('Net::DNS::RR::SOA');
                
                $soa_domain = $rec->name;

                last FIND_SOA if $soa_domain;
            }
        }
    }

    #die "Couldn't find SOA for $domain\n" unless defined $soa_domain;
    $soa_domain ||= $domain;

    my $whois = new Net::ParseWhois::Domain($soa_domain);
    warn "Couldn't connect to Whois server$/", next unless $whois;
    warn "No Whois match for $soa_domain$/", next unless $whois->ok;

    # print out whois match
    print "Whois Server: ", $whois->whois_server, $/;
    print $/;

    print "Registrar: ", $whois->registrar, $/;
    print "Domain: ", $whois->domain, $/;
    print "Name: ", $whois->name, $/;
    print "Tag: ", $whois->tag, $/;
    print $/;

    print "Address:", $/;
    print "\t", $_, $/ for $whois->address;
    print $/;

    print "Country: ", $whois->country, $/;
    print $/;

    print "Name Servers:", $/;
    printf "\t%s (%s)$/", @$_ for @{$whois->servers};
    print $/;

    if (my $c = $whois->contacts)
    {
        print "Contacts:", $/;
        for my $t (sort keys %$c)
        {
            print " " x 4, $t, ":", $/;
            print "\t", $_, $/ for @{$c->{$t}};
        }
        print $/;
    }

    print "Record created: ", $whois->record_created, $/;
    print "Record updated: ", $whois->record_updated, $/;
    print "Record expires: ", $whois->record_expires, $/;

    print "=" x 76, $/ if @ARGV;
}
[download]