DOKK / manpages / debian 11 / libpoe-component-irc-perl / POE::Component::IRC::Cookbook::Resolver.3pm.en
POE::Component::IRC::Cookbook::Resolver(3pm) User Contributed Perl Documentation POE::Component::IRC::Cookbook::Resolver(3pm)

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

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

 #!/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;
 }

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

2018-01-01 perl v5.26.1