File Coverage

blib/lib/Net/SenderBase/Query/DNS.pm
Criterion Covered Total %
statement 15 49 30.6
branch 0 16 0.0
condition 0 3 0.0
subroutine 5 7 71.4
pod 0 2 0.0
total 20 77 25.9


line stmt bran cond sub pod time code
1             # $Id: DNS.pm,v 1.3 2003/07/03 15:11:04 matt Exp $
2              
3             package Net::SenderBase::Query::DNS;
4 1     1   866 use strict;
  1         2  
  1         45  
5 1     1   6 use vars qw($HOST);
  1         2  
  1         59  
6              
7             $HOST = 'test.senderbase.org';
8              
9 1     1   936 use Net::DNS;
  1         121028  
  1         108  
10 1     1   8 use IO::Select;
  1         2  
  1         33  
11 1     1   5 use Net::SenderBase::Results;
  1         2  
  1         1579  
12              
13             sub new {
14 0     0 0   my $class = shift;
15 0           my %attrs = @_;
16              
17 0 0         $attrs{Address} || die "No address";
18 0   0       $attrs{Host} ||= $HOST;
19 0 0         $attrs{Timeout} || die "No timeout";
20              
21 0           my $self = bless { %attrs }, $class;
22              
23 0           my $res = Net::DNS::Resolver->new();
24 0           my $sel = IO::Select->new();
25              
26 0           my $reversed_ip = join('.', reverse(split(/\./,$attrs{Address})));
27              
28 0 0         my $mask = $attrs{Mask} ? ".$attrs{Mask}" : '';
29            
30 0           $sel->add($res->bgsend("$reversed_ip$mask.$attrs{Host}", "TXT"));
31              
32 0           $self->{_sel} = $sel;
33              
34 0           return $self;
35             }
36              
37             sub results {
38 0     0 0   my $self = shift;
39              
40 0           my $res = Net::DNS::Resolver->new();
41 0           my $sel = $self->{_sel};
42              
43 0           my @ready = $sel->can_read($self->{Timeout});
44              
45 0 0         @ready || die "Timeout occurred getting results";
46              
47 0           my @lines;
48            
49 0           for my $socket (@ready) {
50 0           my $query = $res->bgread($socket);
51 0           $sel->remove($socket);
52 0           undef($socket);
53              
54 0 0         if (!$query) {
55 0           die $res->errorstring;
56             }
57              
58 0           foreach my $rr ($query->answer) {
59 0 0         next unless $rr->type eq 'TXT';
60 0           my $line = $rr->txtdata;
61 0 0         if ($line =~ s/^(\d+)-//) {
62 0           my $id = $1;
63 0           $lines[$id] = $line;
64             }
65             else {
66 0           die "Unable to parse TXT record: $line";
67             }
68             }
69             }
70              
71 0 0         @lines || die "No results came back for $self->{Address}";
72            
73 0           return Net::SenderBase::Results->cons($self->{Address}, join('', @lines));
74             }
75              
76             1;