#!/usr/bin/perl use Net::XMPP qw( Client ); $Con = new Net::XMPP::Client(); local $CID = "sparql\@jabber.org"; local $KB = "lv2"; local $OPT = "-f text"; $status = $Con->Connect(hostname=>"jabber.org"); $user = $CID; $user =~ s/@.*//; my @ret = $Con->AuthSend( username => $user, password => "FORGETMENOT-pwd-goes-here", resource => $user ); if ($ret[0] ne "ok") { die "Failed to authenticate to server: $ret[1]"; } # these are really low level $Con->SetCallBacks( send=>\&sendCallBack, receive=>\&receiveCallBack, message=>\&messageCallBack, iq=>\&handleTheIQTag ); # higher level callbacks $Con->SetXPathCallBacks( #"/message[\@type='chat']"=>\&messageChatCB, "/message[\@type='chat']"=>\&otherMessageChatCB, ); $Con->AddNamespace( ns =>"http://www.w3.org/2005/09/xmpp-sparql-binding", tag =>"query", xpath => { SPARQL => { path => "text()" } } ); my $Pres = new Net::XMPP::Presence(); $Pres->SetPresence(from=>"$CID", type=>"available", status=>"online"); $ret = $Con->Send($Pres); $ret = $Con->MessageSend( to => "theno23\@jabber.org", #to => "tialaramex\@jabber.org", subject => "server up", body => "SPARQL server ".`uname -a`." awake", thread => "inform", priority => 10 ); my $quit = 0; while (!$quit) { $status = $Con->Process(1); if (!defined $status) { $error = $Con->GetErrorCode(); die "Fatal error: $error"; } } $Con->Disconnect(); sub otherMessageChatCB { my($i, $m) = @_; my $msg = $m->GetBody(); print("Chat body: ".$msg."\n"); if ($msg =~ /QUIT/) { $quit = 1; } elsif ($msg =~ /SELECT/) { my $to = $m->GetFrom(); my $from = $m->GetTo(); my $id = $m->GetID(); my $query = $msg; sendtextres($from, $to, $id, $query); # my $res = `jxt-query $OPT '$KB' '$query'`; # $res =~ s/\s+/ /g; # # $ret = $Con->MessageSend( # to => $to, # subject => "Results", # body => $res, # thread => "results", # priority => 10 # ); } } sub messageChatCB { my($i, $m) = @_; print("Body: ".$m->GetBody()."\n"); } sub sendCallBack { my ($id, $msg) = @_; print "send: $msg\n"; } sub receiveCallBack { my ($id, $msg) = @_; print $msg."\n"; } sub messageCallBack { print "mesg: ".join(",", @_)."\n"; } sub handleTheIQTag { my($id, $iq) = @_; my $to = $iq->GetFrom(); my $from = $iq->GetTo(); my $id = $iq->GetID(); print("GOT IQ\n"); return; my $query = $iq->GetQuery()->GetSPARQL(); my $namespace = $iq->GetQueryXMLNS(); print "Got $namespace query\n"; if (!$query) { return; } &sendres($from, $to, $id, $query); } sub sendtextres { my($from, $to, $id, $query) = @_; my $qres = `jxt-query $OPT '$KB' '$query'`; $qres =~ s/&/\&/g; $qres =~ s//\>/g; $res = < $qres EOB $Con->Send($res); } sub sendres { my($from, $to, $id, $query) = @_; my $qres = `jxt-query $OPT '$KB' '$query'`; $res = < $qres EOB $Con->Send($res); }