The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.

NAME

POE::Component::IRC::Cookbook::Resolver - A bot that can resolve DNS records

SYNOPSIS

This bot uses POE::Component::Client::DNS to DNS records for channel members.

DESCRIPTION

#!/usr/bin/env perl

use strict;
use warnings;
use IRC::Utils qw(parse_user);
use POE;
use POE::Component::Client::DNS;
use POE::Component::IRC::State;
use POE::Component::IRC::Plugin::AutoJoin;
use POE::Component::IRC::Plugin::BotCommand;

POE::Session->create(
    package_states => [
        main => [ qw(_start irc_botcmd_resolve dns_response) ]
    ],
);

$poe_kernel->run();

sub _start {
    my $heap = $_[HEAP];
    my $irc = POE::Component::IRC::State->spawn(
        Nick   => 'resolver_bot',
        Server => 'irc.freenode.net',
    );
    $heap->{irc} = $irc;

    $irc->plugin_add('AutoJoin', POE::Component::IRC::Plugin::AutoJoin->new(
        Channels => [ '#test_channel1', '#test_channel2' ]
    ));

    $irc->plugin_add('BotCommand', POE::Component::IRC::Plugin::BotCommand->new(
        Commands => {
           resolve => 'Usage: resolve <host>'
        }
    ));

    $heap->{dns} = POE::Component::Client::DNS->spawn();

    $irc->yield(register => 'botcmd_resolve');
    $irc->yield('connect');
    return;
}

sub irc_botcmd_resolve {
    my $dns = $_[HEAP]->{dns};
    my $nick = parse_user( $_[ARG0] );
    my ($channel, $host) = @_[ARG1, ARG2];

    my $res = $dns->resolve(
        event => 'dns_response',
        host => $host,
        context => {
            channel => $channel,
            nick    => $nick,
        },
    );

    $poe_kernel->yield(dns_response => $res) if $res;
    return;
}

sub dns_response {
    my $irc = $_[HEAP]->{irc};
    my $res = $_[ARG0];
    my @answers = $res->{response}
        ? map { $_->rdatastr } $res->{response}->answer()
        : ();

    $irc->yield(
        'privmsg',
        $res->{context}->{channel},
        $res->{context}->{nick} . (@answers
            ? ": @answers"
            : ': no answers for "' . $res->{host} . '"')
    );

    return;
}

AUTHOR

Hinrik Örn Sigurðsson, hinrik.sig@gmail.com