AnyEvent-XMPP
view release on metacpan or search on metacpan
See also AnyEvent::XMPP::Writer for a discussion about the brokenness of
XML in the XMPP specification.
If you have any questions or seek for help look below under "SUPPORT".
REQUIREMENTS
One of the major drawbacks I see for AnyEvent::XMPP is the long list of
required modules to make it work.
AnyEvent
For the I/O events, timers, TCP, TLS, DNS and I/O buffering.
Object::Event
The former AnyEvent::XMPP::Event module has been outsourced to the
Object::Event module to provide a more generic way for more other
modules to register and call event callbacks.
XML::Writer
For writing "XML".
XML::Parser::Expat
lib/AnyEvent/XMPP.pm view on Meta::CPAN
=head1 REQUIREMENTS
One of the major drawbacks I see for AnyEvent::XMPP is the long list of required
modules to make it work.
=over 4
=item L<AnyEvent>
For the I/O events, timers, TCP, TLS, DNS and I/O buffering.
=item L<Object::Event>
The former L<AnyEvent::XMPP::Event> module has been outsourced to the L<Object::Event>
module to provide a more generic way for more other modules to register and call
event callbacks.
=item L<XML::Writer>
For writing "XML".
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
=cut
sub send_iq {
my ($self, $type, $create_cb, $result_cb, %attrs) = @_;
my $id = $self->{iq_id}++;
$self->{iqs}->{$id} = $result_cb;
my $timeout = delete $attrs{timeout} || $self->{default_iq_timeout};
if ($timeout) {
$self->{iq_timers}->{$id} =
AnyEvent->timer (after => $timeout, cb => sub {
delete $self->{iq_timers}->{$id};
my $cb = delete $self->{iqs}->{$id};
$cb->(undef, AnyEvent::XMPP::Error::IQ->new)
});
}
$self->{writer}->send_iq ($id, $type, $create_cb, %attrs);
$id
}
=item B<next_iq_id>
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
%attrs
);
}
sub handle_iq {
my ($self, $node) = @_;
my $type = $node->attr ('type');
my $id = $node->attr ('id');
delete $self->{iq_timers}->{$id} if defined $id;
if ($type eq 'result') {
if (my $cb = delete $self->{iqs}->{$id}) {
eval {
$cb->($node);
};
if ($@) { $self->event (iq_result_cb_exception => $@) }
}
} elsif ($type eq 'error') {
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
);
}
sub _start_whitespace_ping {
my ($self) = @_;
return unless $self->{whitespace_ping_interval} > 0;
$self->{_ws_ping} =
AnyEvent->timer (after => $self->{whitespace_ping_interval}, cb => sub {
$self->{writer}->send_whitespace_ping;
$self->_start_whitespace_ping;
});
}
sub _stop_whitespace_ping {
delete $_[0]->{_ws_ping};
}
lib/AnyEvent/XMPP/Ext/MUC.pm view on Meta::CPAN
my ($room, $error) = @_;
if ($error) {
$self->event (join_error => $room, $error);
} else {
$self->event (enter => $room, $room->get_me);
}
});
} : undef;
$room->{room_join_timer} =
AnyEvent->timer (after => $timeout, cb => sub {
delete $room->{room_join_timer};
$self->uninstall_room ($con, $room);
my $muce = AnyEvent::XMPP::Error::MUC->new (
type => 'join_timeout',
text => "Couldn't join room in time, timeout after $timeout\n"
);
$self->event (join_error => $room, $muce);
});
lib/AnyEvent/XMPP/Ext/MUC.pm view on Meta::CPAN
return unless cmp_jid ($eroom->nick_jid, $room->nick_jid);
if ($error->type eq 'nickname_in_use'
&& exists $args{nickcollision_cb}) {
$nick = $args{nickcollision_cb}->($nick);
$room->send_join ($nick, $args{password}, $args{history});
return;
}
delete $room->{room_join_timer};
$self->uninstall_room ($con, $room);
$muc->unreg_cb ($rcb_id);
},
enter => sub {
my ($muc, $eroom, $user) = @_;
return unless cmp_jid ($eroom->nick_jid, $room->nick_jid);
delete $room->{room_join_timer};
$muc->unreg_cb ($rcb_id);
}
);
$room->send_join ($nick, $args{password}, $args{history});
}
sub install_room {
my ($self, $con, $room_jid) = @_;
lib/AnyEvent/XMPP/Ext/MUC/Room.pm view on Meta::CPAN
sub send_part {
my ($self, $msg, $cb, $timeout) = @_;
$self->check_online or return;
$timeout ||= 60;
my $con = $self->{connection};
my $timeouted = 0;
if ($cb) {
$self->{_part_timeout} =
AnyEvent->timer (after => $timeout, cb => sub {
delete $self->{_part_timeout};
$timeouted = 1;
$self->event ('leave', $self->get_me);
});
$self->{muc}->reg_cb (ext_after_leave => sub {
my ($muc, $room) = @_;
return unless cmp_jid ($room->nick_jid, $self->nick_jid);
delete $self->{_part_timeout};
lib/AnyEvent/XMPP/Ext/Ping.pm view on Meta::CPAN
sub disable_timeout {
my ($self, $con) = @_;
delete $self->{cust_timeouts}->{$con};
}
sub _start_cust_timeout {
my ($self, $con, $rtimeout) = @_;
return unless $con->is_connected;
$self->{cust_timeouts}->{$con} =
AnyEvent->timer (after => $$rtimeout, cb => sub {
delete $self->{cust_timeouts}->{$con};
return unless $con->is_connected;
$self->ping ($con, undef, sub {
my ($t, $e) = @_;
if (defined ($e) && $e->condition eq 'client-timeout') {
$con->disconnect ("exceeded ping timeout of $$rtimeout seconds");
} else {
$self->_start_cust_timeout ($con, $rtimeout)
lib/AnyEvent/XMPP/Ext/Receipts.pm view on Meta::CPAN
=over
=cut
# A hash which stores whether a certain presence supports XEP-0184 receipts.
# Entries are added after we actually send a message and entries are purged
# when the presence goes offline or is replaced (since the new presence might
# have a different feature set while keeping the same jid).
my %supports_receipts = ();
# A hash which stores timers by message id. When a message is acknowledged, the
# corresponding timer is deleted.
my %timers = ();
=item B<new (%args)>
Creates a new receipts handle.
The following keys can be specified:
=over
=item B<disco>
lib/AnyEvent/XMPP/Ext/Receipts.pm view on Meta::CPAN
# looks like this:
# <message from="recipient@jabber.ccc.de/androidDc9226M8"
# id="CA597-36"
# to="me@jabber.ccc.de/18327446281349735808246801">
# <received id="foobar23" xmlns="urn:xmpp:receipts"/>
# </message>
my ($receipt) = $node->find_all ([qw/receipts received/]);
if (defined($receipt)) {
my $id = $receipt->attr('id');
print "(xep0184) message $id acknowledged\n" if $self->{debug};
delete $timers{$id};
# If the recipient acknowledged our message, he *obviously*
# supports receipts.
$supports_receipts{$node->attr('from')} = 1;
$self->stop_event;
}
# Figure out if this is a message which requests a receipt, such as
# <message from="me@jabber.ccc.de/Psi+" id="aae0a" to="recipient@jabber.ccc.de/presence" type="chat" xml:lang="en">
# <body>Did you get this?</body>
# <request xmlns="urn:xmpp:receipts"/>
lib/AnyEvent/XMPP/Ext/Receipts.pm view on Meta::CPAN
# <request xmlns='urn:xmpp:receipts'/>
push @$create_cb, sub {
my $w = shift;
$w->addPrefix('urn:xmpp:receipts', '');
$w->startTag(['urn:xmpp:receipts', 'request']);
$w->endTag;
};
if ($self->{auto_resend} > 0) {
print "(xep0184) expecting reply within " . $self->{auto_resend} . "s\n" if $self->{debug};
# This timer will be deleted when the recipient acknowledges the
# message. Otherwise, it re-sends the message.
$timers{$id} = AnyEvent->timer(
after => $self->{auto_resend},
cb => sub {
print "(xep0184) timeout for id $id\n" if $self->{debug};
if (!$con->is_connected) {
print "(xep0184) skipping re-send: jabber connection offline\n" if $self->{debug};
return;
}
if (!exists($supports_receipts{$to}) || !$supports_receipts{$to}) {
# If we don’t know whether the recipient supports
# message receipts (and we should by now, since we
lib/AnyEvent/XMPP/TestClient.pm view on Meta::CPAN
bless $self, $class;
$self->init;
$self
}
sub init {
my ($self) = @_;
$self->{condvar} = AnyEvent->condvar;
$self->{timeout} =
AnyEvent->timer (
after => $self->{timeout}, cb => sub {
$self->{error} .= "Error: Test Timeout\n";
$self->{condvar}->broadcast;
}
);
my $cl = $self->{client} = AnyEvent::XMPP::Client->new (debug => $self->{debug} || 0);
my ($jid, $password) = split /:/, $ENV{NET_XMPP2_TEST}, 2;
$self->{jid} = $jid;
samples/EVQ.pm view on Meta::CPAN
sub addreq { my $k = $id . "_" . $_[0]; $reqh{$k} = 1; $id++; $k }
sub finreq { delete $reqh{$_[0]}; }
sub push_request {
my ($s, $cb) = @_;
push @req, [$cb, $s];
schedule;
}
our $t;
sub timer {
$t = AnyEvent->timer (after => 1, cb => sub {
schedule;
my $reqcnt = scalar (keys %reqh);
$reqcnt += @req;
my $rreqcnt = scalar (keys %reqh);
warn "$reqcnt outstanding requests [$rreqcnt in progress]\n";
timer ();
});
}
sub start {
$J = AnyEvent->condvar;
timer;
}
sub wait {
$J->wait;
}
1
samples/conference_lister view on Meta::CPAN
our $J = AnyEvent->condvar;
our $datafile = "conferences.stor";
our $data = {};
# locking mechanism for requests
our %req;
our $id = 0;
sub addreq { my $k = $id . "_" . $_[0]; $req{$k} = 1; $id++; $k }
sub finreq { delete $req{$_[0]}; my @k = keys %req; $J->broadcast if @k == 0 }
# timer for status output
our $t;
sub mktimer {
$t = AnyEvent->timer (after => 1, cb => sub {
my @keys = keys %req;
my @ok = grep { $_ !~ /_timer_/ } @keys;
my $timers = scalar (grep { $_ =~ /_timer_/ } @keys);
print "\t*** pending requests $timers timers, and : " . join (',', @ok) . "\n";
mktimer ();
});
}
mktimer;
# server data cache
eval { $data = retrieve $datafile };
print "finished data: " . join (',', keys %$data) . "\n";
sub sync_data { store $data, $datafile }
# MAIN START
my @servers = map { s/^\s*(\S+)\s*$/\1/; $_ } <STDIN>;
my $cl = AnyEvent::XMPP::Client->new ();
my $d = AnyEvent::XMPP::Ext::Disco->new;
samples/conference_lister view on Meta::CPAN
my ($d, $i, $e) = @_;
if ($e) {
print "error on disco items on $jid: " . $e->string . "\n";
} else {
$cb->($i);
}
finreq ($ID)
});
}
my %req_timers;
$cl->reg_cb (
error => sub {
my ($cl, $acc, $err) = @_;
print "ERROR: " . $err->string . "\n";
},
iq_result_cb_exception => sub {
my ($cl, $acc, $ex) = @_;
print "EXCEPTION: $ex\n";
},
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);
my $timer_step = 0.1;
my $timer_cnt = 0;
for my $SERVER (@servers) {
next if $data->{$SERVER};
my $t = $timer_cnt;
my $ID = addreq ("timer_$t");
$req_timers{$t} = AnyEvent->timer (after => $t,
cb => sub {
disco_items ($c, $SERVER, sub {
my ($i) = @_;
print "got items for $SERVER\n";
for my $it ($i->items) {
disco_info ($c, $it->{jid}, sub {
my ($i) = @_;
my @f = grep { $_ =~ /^muc/ } keys %{$i->features || {}};
my @c = grep { $_->{category} eq 'conference' && $_->{type} eq 'text' } $i->identities ();
if (@c && !@f) {
$data->{$SERVER}->{$i->jid} = 1;
print "\t*** found conference " . $i->jid . "\n";
sync_data ();
}
});
}
});
delete $req_timers{$t};
finreq ($ID);
}
);
$timer_cnt += $timer_step;
}
$cl->unreg_me;
},
message => sub {
my ($cl, $acc, $msg) = @_;
print "message from: " . $msg->from . ": " . $msg->any_body . "\n";
}
);
$cl->start;
samples/disco_version view on Meta::CPAN
}
my $j = AnyEvent->condvar;
my $cl = AnyEvent::XMPP::Client->new;# (debug => 1);
my $vers = AnyEvent::XMPP::Ext::Version->new;
$cl->add_extension ($vers);
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 ($vers, $con, $j);
} else {
print "no more jids to query ($out_cnt/$in_cnt)...\n";
last;
}
}
mkti ($con);
samples/retrieve_roster view on Meta::CPAN
jid => $jid,
password => $pass,
initial_presence => -5,
);
$con->reg_cb (
debug_recv => sub { print "< $_[1]\n" },
debug_send => sub { print "> $_[1]\n" },
) if $DEBUG;
my $timer =
AnyEvent->timer (
after => 10, cb => sub { warn "got timeout, exiting..."; $j->broadcast }
);
$con->reg_cb (
session_ready => sub {
my ($con) = @_;
},
error => sub {
my ($con, $error) = @_;
warn "error: " . $error->string . "\n";
samples/room_lister view on Meta::CPAN
);
$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) {
( run in 1.455 second using v1.01-cache-2.11-cpan-49f99fa48dc )