File Coverage

blib/lib/Net/pWhoIs.pm
Criterion Covered Total %
statement 68 84 80.9
branch 10 18 55.5
condition 1 3 33.3
subroutine 8 9 88.8
pod 3 5 60.0
total 90 119 75.6


line stmt bran cond sub pod time code
1             package Net::pWhoIs;
2              
3 1     1   597 use strict;
  1         2  
  1         22  
4 1     1   405 use Socket;
  1         2818  
  1         1149  
5 1     1   799 use IO::Socket::INET;
  1         12816  
  1         5  
6 1     1   610 use Scalar::Util 'reftype';
  1         1  
  1         664  
7              
8             our $VERSION = '0.07';
9            
10             $| = 1;
11              
12             ######################################################
13             sub new {
14             ######################################################
15 1     1 1 409 my ($class, $args) = @_;
16 1         1 my $self;
17              
18 1         3 my %defaults = (
19             pwhoisserver => 'whois.pwhois.org',
20             port => 43,
21             );
22              
23             # Apply defaults.
24 1         2 for my $key (keys %defaults) {
25 2         4 $self->{$key} = $defaults{$key};
26             }
27              
28             # Apply arguments passed by human.
29             # They may clobber our defaults.
30 1         2 for my $key (keys %{$args}) {
  1         2  
31 0         0 $self->{$key} = $args->{$key};
32             }
33              
34 1         2 bless $self, $class;
35              
36 1         4 return $self;
37             }
38              
39             ######################################################
40             sub resolveReq {
41             ######################################################
42 2     2 0 5 my $self = shift;
43 2         4 my $what = shift;
44              
45 2 50       38 if ($what !~ /\\d+\\.\\d+\\.\\d+\\.\\d+/) {
46 2         533596 my @host = gethostbyname($what);
47 2 50       18 if (scalar(@host) == 0) {
48 0         0 return;
49             } else {
50 2         39 return Socket::inet_ntoa($host[4]);
51             }
52             }
53             }
54              
55             ######################################################
56             sub pwhois {
57             ######################################################
58 2     2 1 4 my $self = shift;
59 2         3 my $what = shift;
60              
61 2         4 my @req;
62              
63             # Here for legacy purposes only.
64 2 50       7 if ($self->{req}) {
65 0         0 @req = @{$self->{req}};
  0         0  
66             }
67              
68             # Passed value shall trump legacy.
69 2 50       4 if ($what) {
70 2 100       10 if (Scalar::Util::reftype($what) eq 'ARRAY') {
71 1         2 @req = @{$what};
  1         2  
72             }
73             else {
74 1         2 push @req, $what;
75             }
76             }
77              
78 2 50       5 if (! @req) {
79             # Nothing to process.
80 0         0 return;
81             }
82              
83             my $socket = new IO::Socket::INET (
84             PeerHost => $self->{pwhoisserver},
85             PeerPort => $self->{port},
86 2         14 Proto => 'tcp',
87             );
88 2 50       309280 die "Cannot connect to server $!\n" unless $socket;
89              
90             # Build request
91             # This array is needed to handle hosts which can't be resolved to IP.
92 2         4 my @req_new;
93 2         6 my $request = "begin\n";
94 2         6 for my $elmt (@req) {
95 2         11 my $resolved = $self->resolveReq($elmt);
96 2 50       28 if ($resolved) {
97 2         6 $request .= "$resolved\n";
98 2         9 push @req_new, $elmt;
99             }
100             }
101 2         5 $request .= "end\n";
102              
103 2         26 $socket->send($request);
104 2         392 shutdown($socket, 1);
105              
106 2         6 my $responses;
107 2         219 while (my $line = $socket->getline) {
108 34         274718 $responses .= $line;
109             }
110 2         64 $socket->close();
111              
112 2         88 my %results;
113 2         6 my $cntr = 0;
114 2         11 for my $response (split /\n\n/, $responses) {
115 2         8 my $formatted = $self->formatResponse($response);
116 2         8 $results{$req_new[$cntr++]} = $formatted;
117             }
118              
119 2         26 return \%results;
120             }
121              
122             ######################################################
123             sub formatResponse {
124             ######################################################
125 2     2 0 4 my $self = shift;
126 2         3 my $what = shift;
127              
128 2         14 my @lines = split /\n/, $what;
129              
130 2         3 my %formatted;
131 2         4 for my $line (@lines) {
132 32         70 my ($name, $value) = split /:\s/, $line;
133 32 50 33     71 if ($name && $value) {
134 32         70 $formatted{lc($name)} = $value;
135             }
136             }
137              
138 2         7 return \%formatted;
139             }
140              
141             ######################################################
142             sub printReport {
143             ######################################################
144 0     0 1   my $self = shift;
145 0           my $what = shift;
146              
147 0           my $report;
148 0           for my $req (keys %{$what}) {
  0            
149 0           $report .= sprintf ("Request: %s\n", $req);
150 0           for my $key (sort keys %{$what->{$req}}) {
  0            
151 0           $report .= sprintf("%-22s : %s\n", $key, $what->{$req}{$key});
152             }
153 0           $report .= "\n";
154             }
155 0           return $report;
156             }
157              
158             1;
159              
160             =head1 NAME
161              
162             Net::pWhoIs - Client library for Prefix WhoIs (pWhois)
163              
164             =head1 SYNOPSIS
165              
166             use Net::pWhoIs;
167              
168             my $obj = Net::pWhoIs->new();
169            
170             # You may pass hostnames or IP addresses.
171             my @array = qw(
172             166.70.12.30
173             207.20.243.105
174             67.225.131.208
175             perlmonks.org
176             brokenhost.brokendomain.co
177             8.8.8.8
178             12.12.12.12
179             ftp2.freebsd.org
180             );
181              
182             # You can pass an array.
183             my $output = $obj->pwhois(\@array);
184              
185             # Or you can pass a scalar.
186             my $output = $obj->pwhois('8.8.8.8');
187              
188             # Generate a formatted report.
189             print $obj->printReport($output);
190            
191             # Or manipulate the data yourself.
192             for my $req (keys %{$output}) {
193             # req contains queried item.
194             print $req, "\n";
195             for my $key (keys %{$output->{$req}}) {
196             # key contains name of pwhois query result item. Output ref contains value of pwhois query result item.
197             printf("%s : %s\n", $key, $output->{$req}{$key});
198             }
199              
200             # Or grab it direct.
201             print $output->{$req}{'city'}, "\n";
202             print $output->{$req}{'org-name'}, "\n";
203             }
204              
205              
206             =head1 DESCRIPTION
207              
208             Client library for pWhois service. Includes support for bulk queries.
209              
210             =head1 CONSTRUCTOR
211              
212             =over 4
213              
214             =item $obj = Net::pWhoIs->new( %options )
215              
216             Construct a new C object and return it.
217             Key/value pair arguments may be provided to set up the initial state.
218             The
219              
220             pwhoisserver whois.pwhois.org
221             port 43
222              
223             =back
224              
225             =head1 METHODS
226              
227             The following methods are available:
228              
229             =over 4
230              
231             =item Net::pWhoIs->pwhois()
232              
233             Perform queries on passed arrayref or scalar. Thus both single query and bulk queries supported. Returns a hash of hashrefs. Unresolvable hostnames are skipped.
234              
235             =back
236              
237             =over 4
238              
239             =item Net::pWhoIs->printReport()
240              
241             An optional method which generates a formated report to stdout. Accepts returned output from Net::pWhoIs->pwhois()
242              
243             =back
244              
245             =head1 Client
246              
247             A full featured client is included: pwhoiscli.pl. Pass it hostnames or IP seperated by space.
248              
249             ./pwhoiscli.pl ftp4.freebsd.org cpan.org
250             Request: ftp4.freebsd.org
251             as-org-name : Internet Systems Consortium, Inc.
252             as-path : 852 6939 1280
253             cache-date : 1650437752
254             city : Newmarket
255             country : United States of America
256             country-code : US
257             ip : 149.20.1.200
258             latitude : 43.075798
259             longitude : -70.942732
260             net-name : ISC-NET3
261             org-name : Internet Systems Consortium, Inc.
262             origin-as : 1280
263             prefix : 149.20.1.0/24
264             region : New Hampshire
265             route-originated-date : Mar 22 2022 00:21:20
266             route-originated-ts : 1647908480
267              
268             Request: cpan.org
269             as-org-name : Packet Host, Inc.
270             as-path : 8220 1299 54825
271             cache-date : 1650437752
272             city : Parsippany
273             country : United States of America
274             country-code : US
275             ip : 139.178.67.96
276             latitude : 40.857880
277             longitude : -74.425990
278             net-name : PACKET-HOST-139-178-64-0
279             org-name : Packet Host Inc
280             origin-as : 54825
281             prefix : 139.178.64.0/22
282             region : New Jersey
283             route-originated-date : Apr 12 2022 05:26:23
284             route-originated-ts : 1649741183
285              
286             =head1 OUTPUT HASHREF KEYS
287              
288             The following is the list hashref keys returned by pwhois.
289              
290             as-org-name
291             as-path
292             cache-date
293             city
294             country
295             country-code
296             ip
297             latitude
298             longitude
299             net-name
300             org-name
301             origin-as
302             prefix
303             region
304             route-originated-date
305             route-originated-ts
306              
307             =head1 AUTHOR
308              
309             Matt Hersant
310              
311             =cut