#!/opt/perl/bin/perl
use strict;
use utf8;
use Event;
use AnyEvent;
use Net::XMPP2::Client;

sub append_outputfile {
   open OUT, ">>disco_version.output"
      or die "Couldn't open disco_version.output: $!\n";
   print OUT $_[0];
   close OUT;
}

sub version_req {
   my ($con, $dest) = @_;

   $con->send_iq (
      get => { 
         defns => 'version',
         node => { name => 'query', ns => 'version' }
      },
      sub {
         my ($node, $error) = @_;
         if ($error) {
            warn "$dest: DISCO VERSION ERROR $dest: " . $error->string . "\n";
         } else {
            my (@name) = $node->find_all ([qw/version query/], [qw/version name/]);
            my (@ver)  = $node->find_all ([qw/version query/], [qw/version version/]);
            if (@name and @ver) {
               my $from = $node->attr ('from');
               my $name = $name[0]->text;
               my $ver  =  $ver[0]->text;
               $ver  =~ s/[\n\t]//g;
               $name =~ s/[\n\t]//g;
               print "$dest: $from: name: $name version: $ver\n";
               append_outputfile ("$from\t$name\t$ver\n");
            } else {
               print "$dest: no version\n";
            }
         }
      },
      to => $dest
   );
}

my $j = AnyEvent->condvar;
my $cl = Net::XMPP2::Client->new;
my $t = undef;
my @jids = map { chomp; $_ } <STDIN>;
sub mkti {
   my ($con) = @_;
   $t = AnyEvent->timer (after => 1, cb => sub {
      for (1..50) {
         my $j = pop @jids;
         if ($j) {
            version_req ($con, $j);
         } else {
            print "no more jids to query...\n";
            last;
         }
      }
      mkti ($con);
   });
}
$cl->add_account ('net_xmpp2@jabber.org', 'test');
$cl->reg_cb (
   session_ready => sub {
      my ($cl, $acc) = @_;
      if (@ARGV) {
         version_req ($acc->connection, $ARGV[0]);
      } else {
         mkti ($acc->connection);
      }
      $cl->unreg_me
   },
   disconnect => sub {
      my ($cl, $acc, $h, $p, $reas) = @_;
      print "disconnect ($h:$p): $reas\n";
   },
   error => sub {
      my ($cl, $acc, $err) = @_;
      print "ERROR: " . $err->string . "\n";
   },
   message => sub {
      my ($cl, $acc, $msg) = @_;
      print "message from: " . $msg->from . ": " . $msg->any_body . "\n";
   }
);
$cl->start;
$j->wait;