use strict; use Jabber::Connection; use Jabber::NodeFactory; use Jabber::NS qw(:all); my $NAME = 'Test Component'; my $ID = 'comp.localhost'; my $VERSION = '0.1'; my $c = new Jabber::Connection( server => 'localhost:9999', localname => $ID, ns => NS_ACCEPT, log => 1, debug => 1, ); unless ($c->connect()) { die "oops: ".$c->lastError; } debug("registering IQ handlers"); $c->register_handler('iq',\&iq_version); $c->register_handler('iq',\&iq_notimpl); debug("registering beat"); $c->register_beat(20, \&beep); debug("authenticating"); $c->auth('secret'); debug("starting loop"); $c->start; debug("cleaning up"); $c->disconnect; sub beep { debug("beep!"); } sub iq_version { my $node = shift; debug("[iq_version]"); return unless $node->attr('type') eq IQ_GET and my $query = $node->getTag('', NS_VERSION); debug("--> version request"); $node = toFrom($node); $node->attr('type', IQ_RESULT); $query->insertTag('name')->data($NAME); $query->insertTag('version')->data($VERSION); $query->insertTag('os')->data(`uname -sr`); $c->send($node); return r_HANDLED; } sub iq_notimpl { my $node = shift; $node = toFrom($node); $node->attr('type', IQ_ERROR); my $error = $node->insertTag('error'); $error->attr('code', '501'); $error->data('Not Implemented'); $c->send($node); return r_HANDLED; } sub toFrom { my $node = shift; my $to = $node->attr('to'); $node->attr('to', $node->attr('from')); $node->attr('from', $to); return $node; } sub debug { print STDERR "debug: ", @_, "\n"; }