ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Net-XMPP2/samples/conference_lister
(Generate patch)

Comparing cvsroot/Net-XMPP2/samples/conference_lister (file contents):
Revision 1.2 by elmex, Mon Jul 9 20:24:45 2007 UTC vs.
Revision 1.3 by elmex, Thu Jul 19 11:36:34 2007 UTC

… …
10use XML::DOM::XPath; 10use XML::DOM::XPath;
11 11
12our $J = AnyEvent->condvar; 12our $J = AnyEvent->condvar;
13our $datafile = "conferences.stor"; 13our $datafile = "conferences.stor";
14our $data = {}; 14our $data = {};
15
16sub load_servers {
17 my $parser = XML::DOM::Parser->new;
18 my $doc = $parser->parsefile ("servers.xml");
19
20 my %servers;
21 for ($doc->findnodes ('/query/item')) {
22 my $n = $_->getAttributeNode ('jid');
23 $servers{$n->getValue} = 1;
24 }
25 keys %servers
26}
27 15
28# locking mechanism for requests 16# locking mechanism for requests
29our %req; 17our %req;
30our $id = 0; 18our $id = 0;
31sub addreq { my $k = $id . "_" . $_[0]; $req{$k} = 1; $id++; $k } 19sub addreq { my $k = $id . "_" . $_[0]; $req{$k} = 1; $id++; $k }
… …
48eval { $data = retrieve $datafile }; 36eval { $data = retrieve $datafile };
49print "finished data: " . join (',', keys %$data) . "\n"; 37print "finished data: " . join (',', keys %$data) . "\n";
50sub sync_data { store $data, $datafile } 38sub sync_data { store $data, $datafile }
51 39
52# MAIN START 40# MAIN START
53my @servers = load_servers (); 41my @servers = map { s/^\s*(\S+)\s*$/\1/; $_ } <STDIN>;
54my $cl = Net::XMPP2::Client->new (); 42my $cl = Net::XMPP2::Client->new ();
55my $d = Net::XMPP2::Ext::Disco->new; 43my $d = Net::XMPP2::Ext::Disco->new;
56$cl->add_extension ($d); 44$cl->add_extension ($d);
57$cl->add_account ('net_xmpp2@jabber.org/test', 'test'); 45$cl->add_account ('net_xmpp2@jabber.org/test', 'test');
58 46
… …
103 my ($cl, $acc) = @_; 91 my ($cl, $acc) = @_;
104 print "session ready, requesting items for $ARGV[0]\n"; 92 print "session ready, requesting items for $ARGV[0]\n";
105 my $c = $acc->connection (); 93 my $c = $acc->connection ();
106 $c->set_default_iq_timeout (30); 94 $c->set_default_iq_timeout (30);
107 95
108 my $timer_step = 3; 96 my $timer_step = 0.1;
109 my $timer_cnt = 0; 97 my $timer_cnt = 0;
110 98
111 for my $SERVER (@servers) { 99 for my $SERVER (@servers) {
112 next if $data->{$SERVER}; 100 next if $data->{$SERVER};
113 my $t = $timer_cnt; 101 my $t = $timer_cnt;
… …
115 my $ID = addreq ("timer_$t"); 103 my $ID = addreq ("timer_$t");
116 $req_timers{$t} = AnyEvent->timer (after => $t, 104 $req_timers{$t} = AnyEvent->timer (after => $t,
117 cb => sub { 105 cb => sub {
118 disco_items ($c, $SERVER, sub { 106 disco_items ($c, $SERVER, sub {
119 my ($i) = @_; 107 my ($i) = @_;
108 print "got items for $SERVER\n";
120 for ($i->items) { 109 for my $it ($i->items) {
121 disco_info ($c, $_->{jid}, sub { 110 disco_info ($c, $it->{jid}, sub {
122 my ($i) = @_; 111 my ($i) = @_;
112 my @f = grep { $_ =~ /^muc/ } keys %{$i->features || {}};
123 if (grep { $_->{category} eq 'conference' && $_->{type} eq 'text' } $i->identities ()) { 113 my @c = grep { $_->{category} eq 'conference' && $_->{type} eq 'text' } $i->identities ();
114 if (@c && !@f) {
124 $data->{$SERVER} = $i->jid; 115 $data->{$SERVER}->{$i->jid} = 1;
125 print "\t*** found conference " . $i->jid . "\n"; 116 print "\t*** found conference " . $i->jid . "\n";
126 sync_data (); 117 sync_data ();
127 } 118 }
128 }); 119 });
129 } 120 }

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines