File Coverage

blib/lib/POE/Component/IRC/Plugin/QueryDNSBL.pm
Criterion Covered Total %
statement 31 72 43.0
branch 1 18 5.5
condition 1 16 6.2
subroutine 9 13 69.2
pod 1 5 20.0
total 43 124 34.6


line stmt bran cond sub pod time code
1             package POE::Component::IRC::Plugin::QueryDNSBL;
2             {
3             $POE::Component::IRC::Plugin::QueryDNSBL::VERSION = '1.04';
4             }
5              
6             #ABSTRACT: A POE::Component::IRC plugin for IRC based DNSBL queries
7              
8 1     1   2013013 use strict;
  1         2  
  1         44  
9 1     1   6 use warnings;
  1         2  
  1         30  
10 1     1   6 use POE;
  1         2  
  1         9  
11 1     1   1915 use POE::Component::Client::DNSBL;
  1         5070  
  1         48  
12 1     1   12 use POE::Component::IRC::Plugin qw[:ALL];
  1         4  
  1         204  
13 1     1   6 use Net::IP::Minimal qw[ip_is_ipv4];
  1         2  
  1         1327  
14              
15             sub new {
16 1     1 1 7610 my $package = shift;
17 1         3 my %args = @_;
18 1         5 $args{lc $_} = delete $args{$_} for keys %args;
19 1 50 33     7 delete $args{resolver}
20             unless ref $args{resolver} and $args{resolver}->isa('POE::Component::Client::DNS');
21 1         4 bless \%args, $package;
22             }
23              
24             sub PCI_register {
25 1     1 0 556 my ($self,$irc) = @_;
26 1         18 $irc->plugin_register( $self, 'SERVER', qw(public msg) );
27 1         47 $self->{resolver} = $irc->resolver();
28 1         18 $self->{_dnsbl} = POE::Component::Client::DNSBL->spawn(
29             resolver => $self->{resolver},
30             dnsbl => $self->{dnsbl},
31             );
32 1         451 return 1;
33             }
34              
35             sub PCI_unregister {
36 1     1 0 2427 my $self = shift;
37 1         9 $self->{_dnsbl}->shutdown();
38 1         256 return 1;
39             }
40              
41             sub S_public {
42 0     0 0   my ($self,$irc) = splice @_, 0 , 2;
43 0           my ($nick,$userhost) = ( split /!/, ${ $_[0] } )[0..1];
  0            
44 0           my $channel = ${ $_[1] }->[0];
  0            
45 0           my $what = ${ $_[2] };
  0            
46 0           my $mynick = $irc->nick_name();
47 0   0       my $cmdstr = $self->{command} || 'dnsbl';
48 0           my ($command) = $what =~ m/^\s*\Q$mynick\E[\:\,\;\.]?\s*(.*)$/i;
49 0 0 0       return PCI_EAT_NONE unless ( $command and $command =~ /^\Q$cmdstr\E/i );
50 0           $self->_dns_query( $irc, $channel, 'privmsg', split(/\s+/, $command) );
51 0           return PCI_EAT_NONE;
52             }
53              
54             sub S_msg {
55 0     0 0   my ($self,$irc) = splice @_, 0 , 2;
56 0           my ($nick,$userhost) = ( split /!/, ${ $_[0] } )[0..1];
  0            
57 0           my $string = ${ $_[2] };
  0            
58 0   0       my $cmdstr = $self->{command} || 'dnsbl';
59 0 0 0       return PCI_EAT_NONE unless ( $string and $string =~ /^\Q$cmdstr\E\s+/i );
60 0 0         $self->_dns_query( $irc, $nick, ( $self->{privmsg} ? 'privmsg' : 'notice' ), split(/\s+/, $string) );
61 0           return PCI_EAT_NONE;
62             }
63              
64             sub _dns_query {
65 0     0     my ($self,$irc,$target,$method,$cmdstr,$query,$type) = @_;
66 0 0 0       return unless $cmdstr and $query;
67 0 0         unless ( ip_is_ipv4( $query ) ) {
68 0           $irc->yield( $method, $target, 'That isn\'t an IPv4 address' );
69 0           return;
70             }
71 0           $poe_kernel->state( '_querydnsbl_response', $self, '_response' );
72 0           $self->{_dnsbl}->lookup(
73             event => '_querydnsbl_response',
74             address => $query,
75             _context => { targ => $target, meth => $method, irc => $irc },
76             );
77 0           return 1;
78             }
79              
80             sub _response {
81 0     0     my $response = $_[ARG0];
82 0           my $target = $response->{_context}->{targ};
83 0           my $method = $response->{_context}->{meth};
84 0           my $irc = $response->{_context}->{irc};
85 0 0         if ( $response->{error} ) {
86 0           $irc->yield( $method, $target, 'Thanks, that generated an error!' );
87             }
88             else {
89 0 0         if ( $response->{response} eq 'NXDOMAIN' ) {
90 0           $irc->yield( $method, $target, 'That address is not blacklisted.' );
91             }
92             else {
93 0 0         $irc->yield( $method, $target, join(' ', $response->{response}, ( $response->{reason} ? "[$response->{reason}]" : '' ) ) );
94             }
95             }
96 0           $poe_kernel->state( '_querydnsbl_response' );
97 0           return;
98             }
99              
100             1;
101              
102              
103             __END__