1# Program: Net::ParseWhois::Domain::Registrar class for NameScout
2# Version: 1.0
3# Purpose: Parsing methods and configuration for the NameScout Registrar
4# Written: 11/28/05 by Jeff Mercer <riffer@vaxer.net>
5# Updated: 11/29/05 by Jeff Mercer <riffer@vaxer.net>
6
7package Net::ParseWhois::Domain::Registrar::NameScout;
8
9require 5.004;
10use strict;
11
12@Net::ParseWhois::Domain::Registrar::NameScout::ISA = qw(Net::ParseWhois::Domain::Registrar);
13$Net::ParseWhois::Domain::Registrar::NameScout::VERSION = 0.6;
14
15sub rdebug		{ 0 }
16sub regex_org_start	{ '^Registrant$'}
17sub regex_no_match	{ '^We are unable to process your request at this time.' }
18sub regex_created	{ '^Date Registered: (.*)$' }
19sub regex_expires	{ '^Expiry Date: (.*)$' }
20sub regex_updated	{ '^Date Modified: (.*)$' }
21sub regex_domain	{ '^Domain (.*)$' }
22sub regex_nameservers	{ '^DNS[0-9]+: (.*)$' }
23sub my_nameservers_noips { 1 }
24sub my_contacts		{ [ qw(Administrative Technical) ] }
25sub my_data		{ [ qw(my_contacts my_nameservers_noips regex_org_start regex_no_match regex_created regex_updated regex_expires regex_domain regex_nameservers) ] }
26
27sub parse_text {
28	my $self = shift;
29	my $text = shift; # array ref, one line per element
30
31	$self->dump_text($text) if $self->rdebug;
32
33	$self->parse_domain_name($text);
34	$self->dump_text($text) if $self->rdebug;
35
36	$self->parse_domain_stats($text);
37	$self->dump_text($text) if $self->rdebug;
38
39	$self->parse_nameservers($text);
40	$self->dump_text($text) if $self->rdebug;
41
42	$self->parse_start($text);
43	$self->dump_text($text) if $self->rdebug;
44
45	$self->parse_org($text);
46	$self->dump_text($text) if $self->rdebug;
47
48	$self->parse_contacts($text);
49	$self->dump_text($text) if $self->rdebug;
50
51	return $self;
52}
53
54###############################################################################
55
56# Overload the default parse_start method from the Registar parent class,
57# to handle the extra blank lines NameScout WHOIS throws in.
58#					--jcm, 11/29/05
59sub parse_start {
60	# Initialization
61	my $self = shift;
62	my $text = shift;
63	my $t = shift @{ $text };
64	warn "DEBUG: parse_start() running\n" if $self->rdebug;
65
66	# Keep going through raw text until we find our starting point
67	until (!defined $t || $t =~ /$self->{'regex_org_start'}/ ||
68		$t =~ /$self->{'regex_no_match'}/) { $t = shift @{$text}; }
69
70	#trim leading whitespace
71	$t =~ s/^\s//;
72
73	# Skip to next line if this line is blank
74	$t = shift @{$text} if ($t eq '');
75
76	# If we find a match for the start of registrant data...
77	if ($t =~ /$self->{'regex_org_start'}/) {
78		# Prep the next input line and mark as a Match
79		$t = shift @{ $text };
80		$t = shift @{ $text };
81		$self->{'MATCH'} = 1;
82	}
83
84	# Did we find a match?
85	if ($self->{'MATCH'} ) {
86		# Attempt to parse out registrant name, and tag if any
87		if ($t =~ /^(.*)$/) { $self->{'NAME'} = $1; }
88	}
89
90	warn "DEBUG: parse_start() ending\n" if $self->rdebug;
91}
92
93
94# Replace the default Registrar method for parsing contacts, to deal with
95# extra blank lines given by NameScout WHOIS server	--jcm 11/28/05
96sub parse_contacts {
97	# Initialization
98	my ($self, $text) = @_;
99	my ($done, $t, $blah, $ck);
100	my (@ctypes, @c);
101	warn "DEBUG: parse_contacts() running\n" if $self->rdebug;
102
103	# As long as we have text to eat...
104	while (@{ $text }) {
105		# Check to see if all the contacts have been filled in
106		$done = 1;
107		foreach $ck (@{ $self->{'my_contacts'} }) {
108			warn "DEBUG: ck=$ck\n" if $self->rdebug;
109			unless ($self->{CONTACTS}->{uc($ck)}) { $done = 0; }
110		}
111		last if $done;
112
113		# Grab next line of test, skip it if blank
114		$t = shift(@{ $text });
115		warn "DEBUG: t = $t\n" if $self->rdebug;
116		next if $t=~ /^$/;
117
118		# If this line is a contact header...
119		if ($t =~ /contact.*$/i) {
120			# Figure out what contact type(s) it's for
121			warn "DEBUG: Matched against /contact.*:/ regex\n" if $self->rdebug;
122			@ctypes = ($t =~ /\b(\S+) contact/ig);
123			@c=();
124			if ($self->rdebug) {
125				printf "DEBUG: ctypes=%d\n", $#ctypes+1 if $self->rdebug;
126				foreach (@ctypes) {
127					warn "DEBUG: ctypes contains=$_\n";
128				}
129			}
130			shift(@{ $text });
131
132			# Eat all the text until the next contact line and
133			# store it in hash
134			while ( ${ $text }[0] ) {
135				warn "DEBUG: text[0]=${$text}[0]\n" if $self->rdebug;
136				last if ${ $text }[0] =~ /contact.*:$/i;
137				push @c, shift @{ $text };
138			}
139
140			# Take our contacts hash and map it to our objects
141			# CONTACTS hash. Only I think this is foobar...
142			printf "DEBUG: c=%d\n", $#c+1 if $self->rdebug;
143			foreach (@ctypes) { @{$self->{CONTACTS}{uc $_}}=@c; }
144		}
145	}
146
147	warn "DEBUG: parse_contacts() ending\n" if $self->rdebug;
148}
149
150
151# Overload default parse_nameservers method from parent Registrar class.
152# Nameservers info in NameScout WHOIS output is near top instead of bottom
153# and has no leading block indicator. Each nameserver has a unique prefix
154# so this requires substantially different logic than the default method.
155#						--jcm, 11/29/05
156sub parse_nameservers {
157	# Initialization
158	my ($self, $text) = @_;
159	my ($t, $dns, $key);
160	my (@s, @temp);
161	warn "DEBUG: parse_nameservers() running\n" if $self->rdebug;
162	warn "DEBUG: text = $text, size = $#{$text}\n" if $self->rdebug;
163	warn "DEBUG: Starting text processing loop...\n" if $self->rdebug;
164
165	# Prime the pump
166#	$t = shift(@{$text});
167
168	# As long as there's a nameserver entry to process...
169	while (($t = shift(@{$text})) =~ /$self->{'regex_nameservers'}/) {
170		warn "DEBUG: t = $t\n" if $self->rdebug;
171
172		if ($self->{'my_nameservers_noips'}) {
173			@temp = [ $1, $self->na ];
174			push @s, @temp;
175			warn "DEBUG: Nameserver with no IP\n" if $self->rdebug;
176		} else {
177			push @s, [split /\s+/,  $1];
178			warn "DEBUG: Nameserver with IP\n" if $self->rdebug;
179		}
180
181	}
182
183	# Store our array of nameservers in our instance
184	$self->{SERVERS} = \@s;
185
186	if ($self->rdebug) {
187		foreach $dns (@s) { warn "DEBUG: DNS server = $dns\n"; }
188		warn "DEBUG: parse_nameservers() ending\n";
189	}
190}
191
1921;
193