#!/opt/perl/bin/perl
use strict;
use utf8;
use Event;
use AnyEvent;
use Net::XMPP2::Client;
use Net::XMPP2::Ext::Disco;
use Net::XMPP2::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';
my $cl = Net::XMPP2::Client->new ();
my $d  = Net::XMPP2::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;
      $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 = Net::XMPP2::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) {
            next if $data->{$jid}->{$i->{jid}};

            fetch_room_occupants ($con, $i->{jid}, sub {
               my ($room_jid, $cnt) = @_;
               unless (defined $cnt) {
                  if ($i->{name} =~ /\((\d+)\)\s*$/) {
                     $cnt = $1;
                  }
               }
               $cb->($jid, $i->{jid}, $i->{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 ();

for my $SERVER (keys %{$conferences}) {
   my $conf = $conferences->{$SERVER};
   disco_items ($con, $SERVER, sub {
      my ($i) = @_;
      for ($i->items) {
         disco_info ($con, $_->{jid}, sub {
            my ($i) = @_;
            if (grep { $_->{category} eq 'conference'
                       && $_->{type} eq 'text' } $i->identities ())
            {
               disco_conference ($con, $i->jid, sub {
                  my ($cjid, $rjid, $rname, $rocc) = @_;
                  $data->{$cjid}->{$rjid} = [$cjid, $rjid, $rname, $rocc];
                  sync_data ();
                  printf "\t*** %-30s: %-50s: %3d\n",
                      $cjid, $rjid, $rocc;
               });
            }
         });
      }
   });
}


EVQ::wait ();
