File Coverage

blib/lib/Net/ParseWhois.pm

Criterion	Covered	Total	%
statement	18	54	33.3
branch	0	18	0.0
condition	0	2	0.0
subroutine	6	13	46.1
pod	0	4	0.0
total	24	91	26.3

package Net::ParseWhois;
require 5.004;
use strict;

use IO::Socket;
use IO::File;
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Net::ParseWhois::Domain;

$VERSION = '0.7';

require Exporter;

@ISA = qw(Exporter);
@EXPORT = ();

sub debug {
    my $self = shift;
    my $opt = shift;
    $self->{'debug'} = $opt if ($opt);
    return $self->{'debug'} || 0;
}

# Mapping of whois servers to Top-Level domains. Originally quite sparse,
# these all pointed to whois.nsiregistry.com. --jcm
sub TLDs {
	{
		COM => 'whois.internic.net',
		NET => 'whois.internic.net',
		ORG => 'whois.publicinterestregistry.net',
		EDU => 'whois.educause.net',
		GOV => 'whois.nic.gov',
		MIL => 'whois.nic.mil'
	}
}


# Mapping of TLDs to their WHOIS model. Basically, this will let us know
# if there's any referrals to bother to chase. Generally, we're only going
# to chase referrals for .com and .net domains.		--jcm, 11/10/05
sub TLDModel {
	{
		COM => 'thin',
		NET => 'thin',
		ORG => 'thick',
		EDU => 'thick',
		GOV => 'thick',
		MIL => 'thick'
	}
}


sub _connect {
	my $self = shift;

	unless ($self->{'base_server_addr'}) {
		my $a = gethostbyname $self->{'base_server_name'};
		$self->{'base_server_addr'} = inet_ntoa($a) if $a;
	}

	$self->{'base_server_addr'} or croak 'Net::ParseWhois:: no server';

	warn "connecting to $self->{'base_server_addr'} 43\n" if $self->debug;

	my $sock = IO::Socket::INET->new(PeerAddr => $self->{'base_server_addr'},
						 		PeerPort => 'whois',
								Proto => 'tcp')
		or croak "Net::ParseWhois: Can't connect to $self->{'base_server_name'}: $@";
	$sock->autoflush;
	return $sock;
}

sub _load_module {
	my ($self, $module) = @_;
	eval "use $module";
	die "failed to load $module\n" if $@;
}

sub _send_to_sock {
	my $self = shift;
	my $sock = shift;
	my $text_to_send = shift;
	my $sock_text;

	unless ($text_to_send) {
		print $sock "$self->{'domain'}\x0d\x0a";
	} else {
		print $sock $text_to_send;
	}

	{
		local $/; $sock_text = <$sock>;
	}
	undef $sock;
	$sock_text || die "No data returned from $self->{'base_server_name'}\n";
	$sock_text =~ s/^ +//gm;
	my @text = split / *\x0d?\x0a/, $sock_text;
	for (@text) { s/^ +//} # get rid of leading whitespace
	return \@text;
}



sub US_State {
	{
	AL => 'ALABAMA',
	AK => 'ALASKA',
	AZ => 'ARIZONA',
	AR => 'ARKANSAS',
	CA => 'CALIFORNIA',
	CO => 'COLORADO',
	CT => 'CONNECTICUT',
	DE => 'DELAWARE',
	DC => 'DISTRICT OF COLUMBIA',
	FL => 'FLORIDA',
	GA => 'GEORGIA',
	GU => 'GUAM',
	HI => 'HAWAII',
	ID => 'IDAHO',
	IL => 'ILLINOIS',
	IN => 'INDIANA',
	IA => 'IOWA',
	KS => 'KANSAS',
	KY => 'KENTUCKY',
	LA => 'LOUISIANA',
	ME => 'MAINE',
	MH => 'MARSHALL ISLANDS',
	MD => 'MARYLAND',
	MA => 'MASSACHUSETTS',
	MI => 'MICHIGAN',
	MN => 'MINNESOTA',
	MS => 'MISSISSIPPI',
	MO => 'MISSOURI',
	MT => 'MONTANA',
	'NE' => 'NEBRASKA', # nebraska ne 'a real state', heh
	NV => 'NEVADA',
	NH => 'NEW HAMPSHIRE',
	NJ => 'NEW JERSEY',
	NM => 'NEW MEXICO',
	NY => 'NEW YORK',
	NC => 'NORTH CAROLINA',
	ND => 'NORTH DAKOTA',
	MP => 'NORTHERN MARIANA ISLANDS',
	OH => 'OHIO',
	OK => 'OKLAHOMA',
	OR => 'OREGON',
	PA => 'PENNSYLVANIA',
	PR => 'PUERTO RICO',
	RI => 'RHODE ISLAND',
	SC => 'SOUTH CAROLINA',
	SD => 'SOUTH DAKOTA',
	TN => 'TENNESSEE',
	TX => 'TEXAS',
	UT => 'UTAH',
	VT => 'VERMONT',
	VI => 'VIRGIN ISLANDS',
	VA => 'VIRGINIA',
	WA => 'WASHINGTON',
	WV => 'WEST VIRGINIA',
	WI => 'WISCONSIN',
	WY => 'WYOMING',
	}
}

1;


__END__