Jakiś czas temu zacząłem bawić się AnyEvent , jest to perlowa biblioteka która z jednej strony jest wrapperem do paru event loopów, a z drugiej strony oferuje zeventowizowane funkcje jak timery czy asynchroniczne I/O.

Jednym z modułów jest AnyEvent::XMPP::Client i grzebiąc trochę w jego przykładach postanowiłem naklepać sobie prostego bota

Git source here
Po kolei, najpierw “nudna” część czyli incjalizacja czego trzeba

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

#!/usr/bin/perl
use common::sense;
use AnyEvent;
use AnyEvent::XMPP::Client;
use AnyEvent::XMPP::Ext::Disco;
use AnyEvent::XMPP::Ext::Version;
use AnyEvent::XMPP::Namespaces qw(xmpp_ns);
use YAML;
use File::Slurp;
use Carp; qw( carp croak );
 
my $config_file = 'bot.yaml';
if ( ! -e $config_file) {
    croak("Config file  does not exist, copy default from doc/examples/bot.yaml");
}
my $tmp = read_file($config_file) or croak("Can't load config: $!");
my $cfg = Load($tmp) or croak("Can't parse config: $!");se Carp; qw( carp croak );
 
 
binmode STDOUT, ":utf8";
 
if (!defined($cfg->{'xmpp_user'}) || !defined($cfg->{'xmpp_pass'}) ) {
    croak("Need xmmp_user and xmpp_pass in config!");
}
my $j       = AnyEvent->condvar;
my $cl      = AnyEvent::XMPP::Client->new (debug => 1);
my $disco   = AnyEvent::XMPP::Ext::Disco->new;
my $version = AnyEvent::XMPP::Ext::Version->new;

Teraz czas odpalić jabbera

30
31
32
33
34
35
36

$cl->add_extension ($disco);
$cl->add_extension ($version);
 
$cl->set_presence (undef, 'I\'m a talking bot.', 1);
 
$cl->add_account ($cfg->{'xmpp_user'}, $cfg->{'xmpp_pass'});
warn "connecting to $cfg->{xmpp_user}...\n";

add_extension dodaje wskazane rozszerzenia, w tym wypadku discovery usług i wysyłanie pytania/odpowiedzi na wersję klienta. Teraz już bot powinien być podłączony do serwera i można go “nauczyć” co robić w wypadku otrzymania eventu od serwera:

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

$cl->reg_cb (
   session_ready => sub {
      my ($cl, $acc) = @_;
      warn "connected!\n";
   },
   message => sub {
      my ($cl, $acc, $msg) = @_;
      my ($target_module, undef) = split(/\s+/,$msg->any_body);
      if ( ! defined( $module->{$target_module} ) ) {
          $target_module = 'help'; #show help if nonexisting module is called
      }
      &{$module->{$target_module}}($cl, $acc, $msg);
   },
   contact_request_subscribe => sub {
      my ($cl, $acc, $roster, $contact) = @_;
      $contact->send_subscribed;
      warn "Subscribed to " . $contact->jid."\n";
   },
   error => sub {
      my ($cl, $acc, $error) = @_;
      warn "Error encountered: " . $error->string."\n";
      $j->broadcast;
   },
   disconnect => sub {
      warn "Got disconnected: [@_]\n";
      $j->broadcast;
   },
);

error/disconnect/session_ready w naszym prostym bocie na razie nas nie interesują, jedynym callbackiem (cb w AnyEvent to skrót od callback) który nas interesuje to “message”, jako parametr dostaje połączenie i konto z którego przyszła wiadomość (jeden obiekt może obsługiwać więcej niż jedno konto na raz) oraz samą wiadomość.

W tym przypadku po prostu wyciągam pierwszy kawałek tekstu do spacji i używam go do wybrania funkcji która ma odpowiedzieć na daną wiadomość, wyjaśnienia wymaga krzaczek:
&{$module->{$target_module}}($cl, $acc, $msg);
Wyciąga on referencję do funkcji ( $->module->{$target_module} ), następnie derefuje ją ( &{..} ) i przekazuje parametry odebranej wiadomości ( &{..}($cl, $acc, $msg))

W czymkolwiek poza takim prostym przykładem lepiej jest wydzielić takie funkcję do oddzielnego modułu i wtedy ich wołanie wyglądałoby $message->{$target_module}->respond($cl, $acc, $msg) ale zabawy z modułami zostawie na kolejne części tutoriala ;]

Teraz zostało tylko dodanie metod obsługujących poszczególne komendy:
Na początek prosty help:

38
39
40
41
42
43
44
45
46
47

$module->{'help'} = sub {
    my ($cl, $acc, $msg) = @_;
    my $repl = $msg->make_reply;
    $repl->add_body (
        "\nSupported commands:\n"
            . join("\n", keys(%$module))
    );
    warn "Got message: '".$msg->any_body."' from ".$msg->from."\n";
    $repl->send;
};

$msg->make_reply to metoda do łatwego tworzenia odpowiedzi, generuje ona obiekt z już ustawionym nadawcą i adresatem, wystarczy dodać treść i wysłać. W tym wypadku to proste wylistowanie wszystkich obsługiwanych funkcji

Dodajmy teraz proste “echo”:

48
49
50
51
52
53
54

$module->{'echo'} = sub {
    my ($cl, $acc, $msg) = @_;
    my $repl = $msg->make_reply;
    my (undef, $reply) = split(/\s/,$msg->any_body);
    $repl->add_body ( "Echo: " . $reply);
    $repl->send;
};

$msg->any_body wyciąga “najbardziej sensowne” (szczegóły tutaj) body wiadomości, innym przydatnym parametrem jest $msg->from jeżeli chcemy robić jakieś proste ACLki lub subskrybować nadawcę do czegoś.

I tyle wystarczy do prostego bota. Po tym wystarczy:

$cl->start;
$j->wait;

który odpala co trzeba i czeka na nowe eventy.

Teraz tylko wystarczy odpalić i można gadać ;]

[00:18] 0.Xbot> 
Supported commands:
time
help
echo
[00:18] xani> echo test
[00:18] 0.Xbot> Echo: test
[00:18] xani> time
[00:18] 0.Xbot> Thu Nov  8 00:18:57 2012