File Coverage

blib/lib/AnyEvent/Whois/Raw.pm
Criterion Covered Total %
statement 95 173 54.9
branch 23 52 44.2
condition 7 29 24.1
subroutine 18 26 69.2
pod 2 10 20.0
total 145 290 50.0


line stmt bran cond sub pod time code
1             package AnyEvent::Whois::Raw;
2              
3 6     6   75411 use base 'Exporter';
  6         14  
  6         548  
4 6     6   5662 use AnyEvent;
  6         25666  
  6         192  
5 6     6   4363 use AnyEvent::Socket;
  6         129240  
  6         761  
6 6     6   5157 use AnyEvent::Handle;
  6         39571  
  6         233  
7 6     6   4070 use AnyEvent::HTTP;
  6         43569  
  6         744  
8 6     6   58 use strict;
  6         11  
  6         274  
9 6     6   33 no warnings 'redefine';
  6         11  
  6         1897  
10              
11             our $VERSION = '0.07';
12             our @EXPORT = qw(whois get_whois);
13             our $stash;
14              
15             BEGIN {
16             sub Net::Whois::Raw::smart_eval(&) {
17 0     0 0 0 my @rv = eval {
18 0         0 $_[0]->();
19             };
20 0 0 0     0 if ($@ && $@ =~ /^Call me later/) {
21 0         0 die $@;
22             }
23            
24 0         0 return @rv;
25             }
26            
27             sub require_hook {
28 163     163 0 1046105 my ($self, $fname) = @_;
29            
30 163 100       173628 return if $fname ne 'Net/Whois/Raw.pm';
31 6         22 for my $i (1..$#INC) {
32 48 100       938 if (-e (my $tname = $INC[$i] . '/Net/Whois/Raw.pm')) {
33 6 50       396 open(my $fh, $tname) or next;
34 6         240 return ($fh, \&eval_filter);
35             }
36             }
37 0         0 return;
38             }
39            
40             sub eval_filter {
41 2754 50   2754 0 61879 return 0 if $_ eq '';
42 2754         3774 s/\beval\s*{/smart_eval{/;
43 2754         43901 return 1;
44             }
45            
46 6     6   23 unshift @INC, \&require_hook;
47 6         85 require Net::Whois::Raw;
48             }
49              
50             sub _extract_known_params {
51 5     5   9 my $args = shift;
52 5         36 my %known_params = (
53             timeout => 1,
54             on_prepare => 1,
55             );
56            
57 5         10 my %params;
58 5         9 eval {
59 5         20 for my $i (-2, -2) {
60 6 100       32 if (exists($known_params{$args->[$i-1]})) {
61 1         4 $params{$args->[$i-1]} = $args->[$i];
62 1         10 delete $known_params{$args->[$i-1]};
63 1         9 splice @$args, $i-1, 2;
64             }
65             else {
66 5         8 last;
67             }
68             }
69             };
70            
71 5         54 return \%params;
72             }
73              
74             sub whois {
75 5     5 1 1620 local $stash = {
76             caller => \&_whois,
77             params => _extract_known_params(\@_),
78             args => [@_],
79             };
80            
81 5         13 &_whois;
82             }
83              
84             sub _whois {
85 9     9   17 my $cb = pop;
86            
87 9         13 my ($res_text, $res_srv);
88 9         24 eval {
89 9         47 ($res_text, $res_srv) = Net::Whois::Raw::whois(@_);
90             };
91 9 100       148982 if (!$@) {
    50          
92 4         29 $cb->($res_text, $res_srv);
93             }
94             elsif ($@ !~ /^Call me later/) {
95 0         0 $cb->('', $@);
96             }
97             }
98              
99             sub get_whois {
100 0     0 1 0 local $stash = {
101             caller => \&_get_whois,
102             params => _extract_known_params(\@_),
103             args => [@_],
104             };
105            
106 0         0 &_get_whois;
107             }
108              
109             sub _get_whois {
110 0     0   0 my $cb = pop;
111            
112 0         0 my ($res_text, $res_srv);
113 0         0 eval {
114 0         0 ($res_text, $res_srv) = Net::Whois::Raw::get_whois(@_);
115             };
116 0 0       0 if (!$@) {
    0          
117 0         0 $cb->($res_text, $res_srv);
118             }
119             elsif ($@ !~ /^Call me later/) {
120 0         0 $cb->('', $@);
121             }
122             }
123              
124             sub Net::Whois::Raw::whois_query {
125 9     9 0 399 my $call = $stash->{calls}{whois_query}++;
126 9 100       14 if ($call <= $#{$stash->{results}{whois_query}}) {
  9         111  
127 4         20 return $stash->{results}{whois_query}[$call];
128             }
129            
130 5         27 whois_query_ae(@_);
131 5         741 die "Call me later";
132             }
133              
134             sub whois_query_ae {
135 5     5 0 9 my ($dom, $srv_and_port, $is_ns) = @_;
136              
137            
138 5         57 my $whoisquery = Net::Whois::Raw::Common::get_real_whois_query($dom, $srv_and_port, $is_ns);
139 5         109 my $stash_ref = $stash;
140              
141 5         20 my ($srv, $port) = split /:/, $srv_and_port;
142            
143             tcp_connect $srv, $port || 43, sub {
144 5     5   740 my $fh = shift;
145 5 50       14 unless ($fh) {
146 0         0 $stash_ref->{args}->[-1]->('', "Connection to $srv failed: $!");
147 0         0 return;
148             }
149            
150 5         6 my @lines;
151             my $handle;
152             my $timer = AnyEvent->timer(
153             after => exists $stash_ref->{params}{timeout} ?
154             $stash_ref->{params}{timeout} :
155             $Net::Whois::Raw::TIMEOUT||30,
156             cb => sub {
157 1 50 33     954923 if ($handle && !$handle->destroyed) {
158 1         167 $handle->destroy();
159 1         210 $stash_ref->{args}->[-1]->('', "Connection to $srv timed out");
160             }
161             }
162 5 100 50     70 );
163             $handle = AnyEvent::Handle->new(
164             fh => $fh,
165             on_read => sub {
166 4         2140123 my @l = split /(?<=\n)/, $_[0]->{rbuf};
167 4 50 33     30 if (@lines && substr($lines[-1], -1) ne "\n") {
168 0         0 $lines[-1] .= shift(@l);
169             }
170 4         47 push @lines, @l;
171 4         26 $_[0]->{rbuf} = '';
172             },
173             on_error => sub {
174 0         0 undef $timer;
175 0         0 $handle->destroy();
176 0         0 $stash_ref->{args}->[-1]->('', "Read error from $srv: $!");
177             },
178             on_eof => sub {
179 4         300 undef $timer;
180 4         62 local $stash = $stash_ref;
181 4         36 $handle->destroy();
182 4         168 $stash->{calls}{whois_query} = 0;
183 4         7 push @{$stash->{results}{whois_query}}, \@lines;
  4         22  
184 4         10 $stash->{caller}->(@{$stash->{args}});
  4         23  
185             }
186 5         179 );
187            
188 5         692 $handle->push_write($whoisquery."\015\012");
189             }, sub {
190 5     5   1396 my $fh = shift;
191 5         9 local $stash = $stash_ref;
192 5         12 _sock_prepare_cb($fh, $srv);
193 5   50     98 };
194             }
195              
196             sub _sock_prepare_cb {
197 5     5   7 my ($fh, $srv) = @_;
198            
199 5         19 my $sockname = getsockname($fh);
200 5   50     31 my $timeout = $Net::Whois::Raw::TIMEOUT||30;
201            
202 5 50       16 if (exists $stash->{params}{on_prepare}) {
203 0         0 $timeout = $stash->{params}{on_prepare}->($fh);
204             }
205            
206 5         9 my $rotate_reference = eval { Net::Whois::Raw::get_ips_for_query($srv) };
  5         21  
207            
208 5 50 33     61 if (!$rotate_reference && @Net::Whois::Raw::SRC_IPS && $sockname eq getsockname($fh)) {
      33        
209             # we have ip and there was no bind request in on_prepare callback
210 0         0 $rotate_reference = \@Net::Whois::Raw::SRC_IPS;
211             }
212            
213 5 50       11 if ($rotate_reference) {
214 0         0 my $ip = shift @$rotate_reference;
215 0         0 bind $fh, AnyEvent::Socket::pack_sockaddr(0, parse_address($ip));
216 0         0 push @$rotate_reference, $ip; # rotate ips
217             }
218            
219 5 100       24 return exists $stash->{params}{timeout} ?
220             $stash->{params}{timeout} :
221             $timeout;
222             }
223              
224             sub Net::Whois::Raw::www_whois_query {
225 0     0 0   my $call = $stash->{calls}{www_whois_query}++;
226 0 0         if ($call <= $#{$stash->{results}{www_whois_query}}) {
  0            
227 0           return $stash->{results}{www_whois_query}[$call];
228             }
229            
230 0           www_whois_query_ae(@_);
231 0           die "Call me later";
232             }
233              
234             sub www_whois_query_ae {
235 0     0 0   my ($dom) = (lc shift);
236            
237 0           my ($resp, $url);
238 0           my ($name, $tld) = Net::Whois::Raw::Common::split_domain( $dom );
239 0           my @http_query_urls = @{Net::Whois::Raw::Common::get_http_query_url($dom)};
  0            
240            
241 0           www_whois_query_ae_request(\@http_query_urls, $tld, $dom);
242             }
243              
244             sub www_whois_query_ae_request {
245 0     0 0   my ($urls, $tld, $dom) = @_;
246            
247 0           my $qurl = shift @$urls;
248 0 0         unless ($qurl) {
249 0           push @{$stash->{results}{www_whois_query}}, undef;
  0            
250 0           $stash->{calls}{www_whois_query} = 0;
251 0           $stash->{caller}->(@{$stash->{args}});
  0            
252 0           return;
253             }
254            
255 0 0 0       my $referer = delete $qurl->{form}{referer} if $qurl->{form} && defined $qurl->{form}{referer};
256 0 0 0       my $method = ( $qurl->{form} && scalar(keys %{$qurl->{form}}) ) ? 'POST' : 'GET';
257 0           my $stash_ref = $stash;
258            
259             my $cb = sub {
260 0     0     my ($resp, $headers) = @_;
261 0           local $stash = $stash_ref;
262            
263 0 0 0       if (!$resp || $headers->{Status} > 299) {
264 0           www_whois_query_ae_request($urls, $tld, $dom);
265             }
266             else {
267 0           chomp $resp;
268 0           $resp = Net::Whois::Raw::Common::parse_www_content($resp, $tld, $qurl->{url}, $Net::Whois::Raw::CHECK_EXCEED);
269 0           push @{$stash->{results}{www_whois_query}}, $resp;
  0            
270 0           $stash->{calls}{www_whois_query} = 0;
271 0           $stash->{caller}->(@{$stash->{args}});
  0            
272             }
273 0           };
274            
275 0           my $headers = {Referer => $referer};
276 0           my @params;
277             push @params, on_prepare => sub {
278 0     0     my $fh = shift;
279 0           local $stash = $stash_ref;
280 0           _sock_prepare_cb($fh, 'www_whois');
281 0           };
282            
283 0 0         if (exists $stash->{params}{timeout}) {
284 0           push @params, timeout => $stash->{params}{timeout};
285             }
286            
287 0 0         if ($method eq 'POST') {
288 0           require URI::URL;
289            
290 0           my $curl = URI::URL->new("http:");
291 0           $curl->query_form( %{$qurl->{form}} );
  0            
292 0           http_post $qurl->{url}, $curl->equery, headers => $headers, @params, $cb;
293             }
294             else {
295 0           http_get $qurl->{url}, headers => $headers, @params, $cb;
296             }
297             }
298              
299             1;
300              
301             __END__