view release on metacpan or  search on metacpan

samples/find_servers  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 Storable;
use XML::DOM::XPath;
use IO::Handle;
use EVQ;

my @servers = map { s/^\s*(\S+)\s*$/\1/; $_ } <STDIN>;

my $cl = AnyEvent::XMPP::Client->new ();
my $d  = AnyEvent::XMPP::Ext::Disco->new;
$cl->add_extension ($d);
$cl->add_account ('net_xmpp2@jabber.org/test', 'test');

sub disco_info {
   my ($con, $jid, $cb) = @_;

   EVQ::push_request ("di_$jid", sub {
      my $ID = shift;
      warn ">>$jid?\n";
      $d->request_info ($con, $jid, undef, sub {
         my ($d, $i, $e) = @_;
         if ($e) {
            warn "error on disco info on $jid: " . $e->string . "\n";
         } else {
            $cb->($i);
         }
         EVQ::finreq ($ID)
      });
   });
}

sub disco_items {
   my ($con, $jid, $cb) = @_;

   EVQ::push_request ("dit_$jid", sub {
      my $ID = shift;
      $d->request_items ($con, $jid, undef, sub {
         my ($d, $i, $e) = @_;
         if ($e) {
            warn "error on disco items on $jid: " . $e->string . "\n";
         } else {
            $cb->($i);
         }
         EVQ::finreq ($ID)
      });
   });
}

sub fetch_room_occupants {
   my ($con, $jid, $cb) = @_;

   EVQ::push_request ("fro_$jid", sub {
      my $ID = shift;
      $d->request_info ($con, $jid, undef, sub {
         my ($d, $i, $e) = @_;
         if ($e) {
            warn "error on disco info to $jid for room occupants: " . $e->string . "\n";