Bot.pm

• package Bot
  • init
  • handle
  • dns_resolve
• EOF

package Bot;

use strict;
use warnings;
use Module::Reload;
use POE qw(
    Component::Client::DNS
);

### direct subroutine: setup extra stuff
sub init {
    my($kernel, $heap) = @_;

    ### register "dns_resolve' state
    $kernel->state('dns_resolve', 'Bot');
    ### create DNS resolver
    $heap->{resolver} ||= POE::Component::Client::DNS->spawn();
}

### direct subroutine
sub handle {
    my($kernel, $heap, $dest, $prefix, $what) = @_;

    ### get list of valid Net::DNS::RR types
    my @rr = keys %Net::DNS::RR::RR;
    my $rr_regex = join("|", @rr);

    my $response;
    if ( $what =~ /^reload$/i ) {
        Module::Reload->check;
        $response = "OK, I reloaded";
        Bot::init($kernel, $heap);
    }
    elsif ( $what =~ /^($rr_regex)\s+([\w.-]+)\?\s*$/ ) {
        $heap->{resolver}->resolve(
            type        => $1,
            host        => $2,
            event       => 'dns_resolve',
            context     => { Dest => $dest, Prefix => $prefix },
            timeout     => 15,
        );
    }
    else {
        $response = "are you talking to me? $what?";
    }
    $heap->{Irc}->yield( privmsg => $dest, "$prefix$response" )
        if defined $response;
}

### a POE state: called when a question from irc is resolved
sub dns_resolve {
    my($kernel, $heap, $response) = @_[KERNEL, HEAP, ARG0];
    my $context = $response->{context};
    my $dest = $context->{Dest};
    my $prefix = $context->{Prefix};
    my $irc = $heap->{Irc};
    my $type = $response->{type};
    my $host = $response->{host};

    if ( my $pkt = $response->{response} ) {
        my $rcode = $pkt->header->rcode;
        my $aa = $pkt->header->aa;
        $irc->yield( privmsg => $dest, $prefix .
            "$type record for $host: got " .
                ($aa ? "" : "non-") . "authoritive answer" .
                ( $rcode eq "NOERROR" ? "" : ", $rcode"));
        my @answ = $pkt->answer();
        for my $a ( @answ ) {
            my $astr = $a->string();
            $astr =~ s/;.*$/ /gm;
            $astr =~ s/[\t\n]/  /g;
            $irc->yield( privmsg => $dest, $prefix . $astr );
        }
    }
    else {
        my $err = $response->{error};
        $irc->yield( privmsg => $dest, $prefix .
            "Cannot find $type records for $host: $err" );
    }
}

1;