#!/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 EVQ;
our $datafile = "room_data.stor";
our $data = {};
eval { $data = retrieve $datafile };
sub sync_data { store $data, $datafile }
# MAIN START
my $conferences = retrieve 'conferences.stor';
if ($ARGV[0] eq 'stat') {
my @srv = keys %$conferences;
my %conf;
for (map { my $s = pop @$_; my $a = $_; map { $s . ":" . $_ } @$a } map { [$_, keys %{$conferences->{$_}}] } keys %$conferences) {
$conf{$_} = 1;
}
print "servers with conferences: " . scalar (@srv) . "\n";
print "conferences : " . scalar (join ",\n", keys %conf) . "\n";
exit;
}
my $cl = AnyEvent::XMPP::Client->new ();
my $d = AnyEvent::XMPP::Ext::Disco->new;
$cl->add_extension ($d);
$cl->add_account ('net_xmpp2@jabber.org/test2', 'test');
sub disco_info {
my ($con, $jid, $cb) = @_;
EVQ::push_request ("di_$jid", sub {
my $ID = shift;
$d->request_info ($con, $jid, undef, sub {
my ($d, $i, $e) = @_;
if ($e) {
print "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) {
print "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) {
print "error on disco info to $jid for room occupants: " . $e->string . "\n";
} else {
my (@q) = $i->xml_node ()->find_all ([qw/data_form x/]);
if (@q) {
my $df = AnyEvent::XMPP::Ext::DataForm->new;
$df->from_node (@q);
if (my $f = $df->get_field ('muc#roominfo_occupants')) {
$cb->($jid, $f->{values}->[0]);
EVQ::finreq ($ID);
return;
}
}
$cb->($jid);
}
EVQ::finreq ($ID);
});
});
}
sub disco_conference {
my ($con, $jid, $cb) = @_;
EVQ::push_request ("dc_$jid", sub {
my $ID = shift;
disco_items ($con, $jid, sub {
my ($items) = @_;
for my $i ($items->items) {
my $room_name = $i->{name};
fetch_room_occupants ($con, $i->{jid}, sub {
my ($room_jid, $cnt) = @_;
unless (defined $cnt) {
if ($room_name =~ /\((\d+)\)\s*$/) {
$cnt = $1;
}
}
$cb->($jid, $room_jid, $room_name, $cnt);
});
}
EVQ::finreq ($ID);
});
});
}
my $con;
my $A = AnyEvent->condvar;
$cl->reg_cb (
error => sub {
my ($cl, $acc, $err) = @_;
print "ERROR: " . $err->string . "\n";
1
},
iq_result_cb_exception => sub {
my ($cl, $acc, $ex) = @_;
print "EXCEPTION: $ex\n";
1
},
session_ready => sub {
my ($cl, $acc) = @_;
print "session ready, requesting items for $ARGV[0]\n";
my $c = $acc->connection ();
$c->set_default_iq_timeout (30);
$con = $c;
$A->broadcast;
0
},
message => sub {
my ($cl, $acc, $msg) = @_;
print "message from: " . $msg->from . ": " . $msg->any_body . "\n";
1
}
);
$cl->start;
$A->wait;
print "EVQ start\n";
EVQ::start ();
my $t;
sub mkti { $t = AnyEvent->timer (after => 10, cb => sub { sync_data (); mkti (); }) }
mkti;
for my $SERVER (keys %{$conferences}) {
my $conf = $conferences->{$SERVER};
for my $cj (keys %$conf) {
disco_conference ($con, $cj, sub {
my ($cjid, $rjid, $rname, $rocc) = @_;
my $prev = $data->{$cjid}->{$rjid};
if ($prev) {
if ($prev->[3] < $rocc) {
$data->{$cjid}->{$rjid} = [$cjid, $rjid, $rname, $rocc];
}
} else {
$data->{$cjid}->{$rjid} = [$cjid, $rjid, $rname, $rocc];
}
printf "\t*** %-30s: %-50s: %3d\n",
$cjid, $rjid, $rocc;
});
}
}
EVQ::wait ();