AnyEvent-XMPP

 view release on metacpan or  search on metacpan

samples/disco_info  view on Meta::CPAN

#!/opt/perl/bin/perl
use strict;
use utf8;
use AnyEvent;
use AnyEvent::XMPP::Client;
use AnyEvent::XMPP::Ext::Disco;
use AnyEvent::XMPP::Ext::DataForm;
use AnyEvent::XMPP::Ext::Version;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;

binmode STDOUT, ":utf8";

my ($jid, $pw, $discodest, $disconode) = @ARGV;

unless (@ARGV >= 3) {
   warn "usage: disco_info <jid> <password> <disco-request-destination-jid> [<disco-node>]\n";
   exit;
}

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;
$cl->add_extension ($disco);
$cl->add_extension ($version);

$cl->set_presence ('away', 'I\'m a bot now.', -1);

$cl->add_account ($jid, $pw);
warn "connecting to $jid...\n";

my ($gitems, $ginfo, $gvers);

$cl->reg_cb (
   session_ready => sub {
      my ($cl, $acc) = @_;
      my $con = $acc->connection;
      my $cnt = 0;
      warn "session ready for $jid!\n";

      $disco->request_items ($con, $discodest, $disconode, sub {
         my ($disco, $items, $error) = @_;
         if ($error) {
            warn "DISCO ITEM ERROR: " . $error->string . "\n";
         } else {
            $gitems = $items;
         }
         $cnt++; $j->broadcast if $cnt > 1;
      });

      $disco->request_info ($con, $discodest, $disconode, sub {
         my ($disco, $info, $error) = @_;
         if ($error) {
            warn "DISCO INFO ERROR: " . $error->string . "\n";
            $cnt++; $j->broadcast if $cnt > 1;
         } else {
            $ginfo = $info;

            if ($info->features->{xmpp_ns ('version')}) {
               $version->request_version ($con, $discodest, sub {
                  my ($vers, $err) = @_;
                  $gvers = $vers;
                  if ($err) {
                     warn "VERSION ERROR: " . $err->string . "\n";
                  }
                  $cnt++; $j->broadcast if $cnt > 1;
               });
            } else {
               $cnt++; $j->broadcast if $cnt > 1;
            }
         }



( run in 1.497 second using v1.01-cache-2.11-cpan-39bf76dae61 )