Context Navigation

source: perl/modules/Jabber/lib/Net/Jabber/Protocol.pm @ 8574801

Visit:

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9

Last change on this file since 8574801 was c2bed55, checked in by Nelson Elhage <nelhage@mit.edu>, 18 years ago
Moving Net::Jabber into Jabber.par
Property mode set to `100644`
File size: 101.2 KB

Line
1	##############################################################################
2	#
3	# This library is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU Library General Public
5	# License as published by the Free Software Foundation; either
6	# version 2 of the License, or (at your option) any later version.
7	#
8	# This library is distributed in the hope that it will be useful,
9	# but WITHOUT ANY WARRANTY; without even the implied warranty of
10	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11	# Library General Public License for more details.
12	#
13	# You should have received a copy of the GNU Library General Public
14	# License along with this library; if not, write to the
15	# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
16	# Boston, MA 02111-1307, USA.
17	#
18	# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
19	#
20	##############################################################################
21
22	package Net::Jabber::Protocol;
23
24	=head1 NAME
25
26	Net::Jabber::Protocol - Jabber Protocol Library
27
28	=head1 SYNOPSIS
29
30	Net::Jabber::Protocol is a module that provides a developer easy
31	access to the Jabber Instant Messaging protocol. It provides high
32	level functions to the Net::Jabber Client, Component, and Server
33	objects. These functions are automatically indluded in those modules
34	through AUTOLOAD and delegates.
35
36	=head1 DESCRIPTION
37
38	Protocol.pm seeks to provide enough high level APIs and automation of
39	the low level APIs that writing a Jabber Client/Transport in Perl is
40	trivial. For those that wish to work with the low level you can do
41	that too, but those functions are covered in the documentation for
42	each module.
43
44	Net::Jabber::Protocol provides functions to login, send and receive
45	messages, set personal information, create a new user account, manage
46	the roster, and disconnect. You can use all or none of the functions,
47	there is no requirement.
48
49	For more information on how the details for how Net::Jabber is written
50	please see the help for Net::Jabber itself.
51
52	For more information on writing a Client see Net::Jabber::Client.
53
54	For more information on writing a Transport see Net::Jabber::Transport.
55
56	=head2 Modes
57
58	Several of the functions take a mode argument that let you specify how
59	the function should behave:
60
61	block - send the packet with an ID, and then block until an answer
62	comes back. You can optionally specify a timeout so that
63	you do not block forever.
64
65	nonblock - send the packet with an ID, but then return that id and
66	control to the master program. Net::Jabber is still
67	tracking this packet, so you must use the CheckID function
68	to tell when it comes in. (This might not be very
69	useful...)
70
71	passthru - send the packet with an ID, but do NOT register it with
72	Net::Jabber, then return the ID. This is useful when
73	combined with the XPath function because you can register
74	a one shot function tied to the id you get back.
75
76
77	=head2 Basic Functions
78
79	use Net::Jabber qw( Client );
80	$Con = Net::Jabber::Client->new(); # From
81	$status = $Con->Connect(hostname=>"jabber.org"); # Net::Jabber::Client
82
83	or
84
85	use Net::Jabber qw( Component );
86	$Con = Net::Jabber::Component->new(); #
87	$status = $Con->Connect(hostname=>"jabber.org", # From
88	secret=>"bob"); # Net::Jabber::Component
89
90
91	#
92	# For callback setup, see Net::XMPP::Protocol
93	#
94
95	$Con->Info(name=>"Jarl",
96	version=>"v0.6000");
97
98	=head2 ID Functions
99
100	$id = $Con->SendWithID($sendObj);
101	$id = $Con->SendWithID("<tag>XML</tag>");
102	$receiveObj = $Con->SendAndReceiveWithID($sendObj);
103	$receiveObj = $Con->SendAndReceiveWithID($sendObj,
104	10);
105	$receiveObj = $Con->SendAndReceiveWithID("<tag>XML</tag>");
106	$receiveObj = $Con->SendAndReceiveWithID("<tag>XML</tag>",
107	5);
108	$yesno = $Con->ReceivedID($id);
109	$receiveObj = $Con->GetID($id);
110	$receiveObj = $Con->WaitForID($id);
111	$receiveObj = $Con->WaitForID($id,
112	20);
113
114	=head2 IQ Functions
115
116	=head2 Agents Functions
117
118	%agents = $Con->AgentsGet();
119	%agents = $Con->AgentsGet(to=>"transport.jabber.org");
120
121	=head2 Browse Functions
122
123	%hash = $Con->BrowseRequest(jid=>"jabber.org");
124	%hash = $Con->BrowseRequest(jid=>"jabber.org",
125	timeout=>10);
126
127	$id = $Con->BrowseRequest(jid=>"jabber.org",
128	mode=>"nonblock");
129
130	$id = $Con->BrowseRequest(jid=>"jabber.org",
131	mode=>"passthru");
132
133	=head2 Browse DB Functions
134
135	$Con->BrowseDBDelete("jabber.org");
136	$Con->BrowseDBDelete(Net::Jabber::JID);
137
138	$presence = $Con->BrowseDBQuery(jid=>"bob\@jabber.org");
139	$presence = $Con->BrowseDBQuery(jid=>Net::Jabber::JID);
140	$presence = $Con->BrowseDBQuery(jid=>"users.jabber.org",
141	timeout=>10);
142	$presence = $Con->BrowseDBQuery(jid=>"conference.jabber.org",
143	refresh=>1);
144
145	=head2 Bystreams Functions
146
147	%hash = $Con->ByteStreamsProxyRequest(jid=>"proxy.server");
148	%hash = $Con->ByteStreamsProxyRequest(jid=>"proxy.server",
149	timeout=>10);
150
151	$id = $Con->ByteStreamsProxyRequest(jid=>"proxy.server",
152	mode=>"nonblock");
153
154	$id = $Con->ByteStreamsProxyRequest(jid=>"proxy.server",
155	mode=>"passthru");
156
157
158	%hash = $Con->ByteStreamsProxyParse($query);
159
160
161	$status = $Con->ByteStreamsProxyActivate(sid=>"stream_id",
162	jid=>"proxy.server");
163	$status = $Con->ByteStreamsProxyActivate(sid=>"stream_id",
164	jid=>"proxy.server",
165	timeout=>10);
166
167	$id = $Con->ByteStreamsProxyActivate(sid=>"stream_id",
168	jid=>"proxy.server",
169	mode=>"nonblock");
170
171	$id = $Con->ByteStreamsProxyActivate(sid=>"stream_id",
172	jid=>"proxy.server",
173	mode=>"passthru");
174
175
176	$jid = $Con->ByteStreamsOffer(sid=>"stream_id",
177	streamhosts=>[{jid=>"jid",
178	host=>"host",
179	port=>"port",
180	zeroconf=>"zero",
181	},
182	...
183	],
184	jid=>"bob\@jabber.org");
185	$jid = $Con->ByteStreamsOffer(sid=>"stream_id",
186	streamhosts=>[{},{},...],
187	jid=>"bob\@jabber.org",
188	timeout=>10);
189
190	$id = $Con->ByteStreamsOffer(sid=>"stream_id",
191	streamhosts=>[{},{},...],
192	jid=>"bob\@jabber.org",
193	mode=>"nonblock");
194
195	$id = $Con->ByteStreamsOffer(sid=>"stream_id",
196	streamhosts=>[{},{},...],
197	jid=>"bob\@jabber.org",
198	mode=>"passthru");
199
200	=head2 Disco Functions
201
202	%hash = $Con->DiscoInfoRequest(jid=>"jabber.org");
203	%hash = $Con->DiscoInfoRequest(jid=>"jabber.org",
204	node=>"node...");
205	%hash = $Con->DiscoInfoRequest(jid=>"jabber.org",
206	node=>"node...",
207	timeout=>10);
208
209	$id = $Con->DiscoInfoRequest(jid=>"jabber.org",
210	mode=>"nonblock");
211	$id = $Con->DiscoInfoRequest(jid=>"jabber.org",
212	node=>"node...",
213	mode=>"nonblock");
214
215	$id = $Con->DiscoInfoRequest(jid=>"jabber.org",
216	mode=>"passthru");
217	$id = $Con->DiscoInfoRequest(jid=>"jabber.org",
218	node=>"node...",
219	mode=>"passthru");
220
221
222	%hash = $Con->DiscoInfoParse($query);
223
224
225	%hash = $Con->DiscoItemsRequest(jid=>"jabber.org");
226	%hash = $Con->DiscoItemsRequest(jid=>"jabber.org",
227	timeout=>10);
228
229	$id = $Con->DiscoItemsRequest(jid=>"jabber.org",
230	mode=>"nonblock");
231
232	$id = $Con->DiscoItemsRequest(jid=>"jabber.org",
233	mode=>"passthru");
234
235
236	%hash = $Con->DiscoItemsParse($query);
237
238	=head2 Feature Negotiation Functions
239
240
241	%hash = $Con->FeatureNegRequest(jid=>"jabber.org",
242	features=>{ feat1=>["opt1","opt2",...],
243	feat2=>["optA","optB",...]
244	}
245	);
246	%hash = $Con->FeatureNegRequest(jid=>"jabber.org",
247	features=>{ ... },
248	timeout=>10);
249
250	$id = $Con->FeatureNegRequest(jid=>"jabber.org",
251	features=>{ ... },
252	mode=>"nonblock");
253
254	$id = $Con->FeatureNegRequest(jid=>"jabber.org",
255	features=>{ ... },
256	mode=>"passthru");
257
258	my $query = $self->FeatureNegQuery(\{ ... });
259	$iq->AddQuery($query);
260
261	%hash = $Con->FeatureNegParse($query);
262
263	=head2 File Transfer Functions
264
265	$method = $Con->FileTransferOffer(jid=>"bob\@jabber.org",
266	sid=>"stream_id",
267	filename=>"/path/to/file",
268	methods=>["http://jabber.org/protocol/si/profile/bytestreams",
269	"jabber:iq:oob",
270	...
271	]
272	);
273	$method = $Con->FileTransferOffer(jid=>"bob\@jabber.org",
274	sid=>"stream_id",
275	filename=>"/path/to/file",
276	methods=>\@methods,
277	timeout=>"10");
278
279	$id = $Con->FileTransferOffer(jid=>"bob\@jabber.org",
280	sid=>"stream_id",
281	filename=>"/path/to/file",
282	methods=>\@methods,
283	mode=>"nonblock");
284
285	$id = $Con->FileTransferOffer(jid=>"bob\@jabber.org",
286	sid=>"stream_id",
287	filename=>"/path/to/file",
288	methods=>\@methods,
289	mode=>"passthru");
290
291	=head2 Last Functions
292
293	$Con->LastQuery();
294	$Con->LastQuery(to=>"bob@jabber.org");
295
296	%result = $Con->LastQuery(mode=>"block");
297	%result = $Con->LastQuery(to=>"bob@jabber.org",
298	mode=>"block");
299
300	%result = $Con->LastQuery(to=>"bob@jabber.org",
301	mode=>"block",
302	timeout=>10);
303	%result = $Con->LastQuery(mode=>"block",
304	timeout=>10);
305
306	$Con->LastSend(to=>"bob@jabber.org");
307
308	$seconds = $Con->LastActivity();
309
310	=head2 Multi-User Chat Functions
311
312	$Con->MUCJoin(room=>"jabber",
313	server=>"conference.jabber.org",
314	nick=>"nick");
315
316	$Con->MUCJoin(room=>"jabber",
317	server=>"conference.jabber.org",
318	nick=>"nick",
319	password=>"secret");
320
321	=head2 Register Functions
322
323	@result = $Con->RegisterSendData("users.jabber.org",
324	first=>"Bob",
325	last=>"Smith",
326	nick=>"bob",
327	email=>"foo@bar.net");
328
329
330	=head2 RPC Functions
331
332	$query = $Con->RPCEncode(type=>"methodCall",
333	methodName=>"methodName",
334	params=>[param,param,...]);
335	$query = $Con->RPCEncode(type=>"methodResponse",
336	params=>[param,param,...]);
337	$query = $Con->RPCEncode(type=>"methodResponse",
338	faultCode=>4,
339	faultString=>"Too many params");
340
341	@response = $Con->RPCParse($iq);
342
343	@response = $Con->RPCCall(to=>"dataHouse.jabber.org",
344	methodname=>"numUsers",
345	params=>[ param,param,... ]
346	);
347
348	$Con->RPCResponse(to=>"you\@jabber.org",
349	params=>[ param,param,... ]);
350
351	$Con->RPCResponse(to=>"you\@jabber.org",
352	faultCode=>"4",
353	faultString=>"Too many parameters"
354	);
355
356	$Con->RPCSetCallBacks(myMethodA=>\&methoda,
357	myMethodB=>\&do_somthing,
358	etc...
359	);
360
361	=head2 Search Functions
362
363	%fields = $Con->SearchRequest();
364	%fields = $Con->SearchRequest(to=>"users.jabber.org");
365	%fields = $Con->SearchRequest(to=>"users.jabber.org",
366	timeout=>10);
367
368	$Con->SearchSend(to=>"somewhere",
369	name=>"",
370	first=>"Bob",
371	last=>"",
372	nick=>"bob",
373	email=>"",
374	key=>"some key");
375
376	$Con->SearchSendData("users.jabber.org",
377	first=>"Bob",
378	last=>"",
379	nick=>"bob",
380	email=>"");
381
382	=head2 Time Functions
383
384	$Con->TimeQuery();
385	$Con->TimeQuery(to=>"bob@jabber.org");
386
387	%result = $Con->TimeQuery(mode=>"block");
388	%result = $Con->TimeQuery(to=>"bob@jabber.org",
389	mode=>"block");
390
391	$Con->TimeSend(to=>"bob@jabber.org");
392
393	=head2 Version Functions
394
395	$Con->VersionQuery();
396	$Con->VersionQuery(to=>"bob@jabber.org");
397
398	%result = $Con->VersionQuery(mode=>"block");
399	%result = $Con->VersionQuery(to=>"bob@jabber.org",
400	mode=>"block");
401
402	$Con->VersionSend(to=>"bob@jabber.org",
403	name=>"Net::Jabber",
404	ver=>"1.0a",
405	os=>"Perl");
406
407	=head1 METHODS
408
409	=head2 Basic Functions
410
411	Info(name=>string, - Set some information so that Net::Jabber
412	version=>string) can auto-reply to some packets for you to
413	reduce the work you have to do.
414
415	NOTE: This requires that you use the
416	SetIQCallBacks methodology and not the
417	SetCallBacks for <iq/> packets.
418
419	=head2 IQ Functions
420
421	=head2 Agents Functions
422
423	********************************
424	* *
425	* Deprecated in favor of Disco *
426	* *
427	********************************
428
429	AgentsGet(to=>string, - takes all of the information and
430	AgentsGet() builds a Net::Jabber::IQ::Agents packet.
431	It then sends that packet either to the
432	server, or to the specified transport,
433	with an ID and waits for that ID to return.
434	Then it looks in the resulting packet and
435	builds a hash that contains the values
436	of the agent list. The hash is layed out
437	like this: (NOTE: the jid is the key to
438	distinguish the various agents)
439
440	$hash{<JID>}->{order} = 4
441	->{name} = "ICQ Transport"
442	->{transport} = "ICQ #"
443	->{description} = "ICQ..blah.."
444	->{service} = "icq"
445	->{register} = 1
446	->{search} = 1
447	etc...
448
449	The order field determines the order that
450	it came from the server in... in case you
451	care. For more info on the valid fields
452	see the Net::Jabber::Query jabber:iq:agent
453	namespace.
454
455	=head2 Browse Functions
456
457	********************************
458	* *
459	* Deprecated in favor of Disco *
460	* *
461	********************************
462
463	BrowseRequest(jid=>string, - sends a jabber:iq:browse request to
464	mode=>string, the jid passed as an argument.
465	timeout=>int) Returns a hash with the resulting
466	tree if mode is set to "block":
467
468	$browse{'category'} = "conference"
469	$browse{'children'}->[0]
470	$browse{'children'}->[1]
471	$browse{'children'}->[11]
472	$browse{'jid'} = "conference.jabber.org"
473	$browse{'name'} = "Jabber.org Conferencing Center"
474	$browse{'ns'}->[0]
475	$browse{'ns'}->[1]
476	$browse{'type'} = "public"
477
478	The ns array is an array of the
479	namespaces that this jid supports.
480	The children array points to hashs
481	of this form, and represent the fact
482	that they can be browsed to.
483
484	See MODES above for using the mode
485	and timeout.
486
487	=head2 Browse DB Functions
488
489	BrowseDBDelete(string\|Net::Jabber::JID) - delete thes JID browse
490	data from the DB.
491
492	BrowseDBQuery(jid=>string \| NJ::JID, - returns the browse data
493	timeout=>integer, for the requested JID. If
494	refresh=>0\|1) the DB does not contain
495	the data for the JID, then
496	it attempts to fetch the
497	data via BrowseRequest().
498	The timeout is passed to
499	the BrowseRequest() call,
500	and refresh tells the DB
501	to request the data, even
502	if it already has some.
503
504	=head2 Bytestreams Functions
505
506	ByteStreamsProxyRequest(jid=>string, - sends a bytestreams request
507	mode=>string, to the jid passed as an
508	timeout=>int) argument. Returns an array
509	ref with the resulting tree
510	if mode is set to "block".
511
512	See ByteStreamsProxyParse
513	for the format of the
514	resulting tree.
515
516	See MODES above for using
517	the mode and timeout.
518
519	ByteStreamsProxyParse(Net::Jabber::Query) - parses the query and
520	returns an array ref
521	to the resulting tree:
522
523	$host[0]->{jid} = "bytestreams1.proxy.server";
524	$host[0]->{host} = "proxy1.server";
525	$host[0]->{port} = "5006";
526	$host[1]->{jid} = "bytestreams2.proxy.server";
527	$host[1]->{host} = "proxy2.server";
528	$host[1]->{port} = "5007";
529	...
530
531	ByteStreamsProxyActivate(jid=>string, - sends a bytestreams activate
532	sid=>string, to the jid passed as an
533	mode=>string, argument. Returns 1 if the
534	timeout=>int) proxy activated (undef if
535	it did not) if mode is set
536	to "block".
537
538	sid is the stream id that
539	is being used to talk about
540	this stream.
541
542	See MODES above for using
543	the mode and timeout.
544
545	ByteStreamsOffer(jid=>string, - sends a bytestreams offer
546	sid=>string, to the jid passed as an
547	streamhosts=>arrayref argument. Returns the jid
548	mode=>string, of the streamhost that the
549	timeout=>int) user selected if mode is set
550	to "block".
551
552	streamhosts is the same
553	format as the array ref
554	returned from
555	ByteStreamsProxyParse.
556
557	See MODES above for using
558	the mode and timeout.
559
560	=head2 Disco Functions
561
562	DiscoInfoRequest(jid=>string, - sends a disco#info request to
563	node=>string, the jid passed as an argument,
564	mode=>string, and the node if specified.
565	timeout=>int) Returns a hash with the resulting
566	tree if mode is set to "block".
567
568	See DiscoInfoParse for the format
569	of the resulting tree.
570
571	See MODES above for using the mode
572	and timeout.
573
574	DiscoInfoParse(Net::Jabber::Query) - parses the query and
575	returns a hash ref
576	to the resulting tree:
577
578	$info{identity}->[0]->{category} = "groupchat";
579	$info{identity}->[0]->{name} = "Public Chatrooms";
580	$info{identity}->[0]->{type} = "public";
581
582	$info{identity}->[1]->{category} = "groupchat";
583	$info{identity}->[1]->{name} = "Private Chatrooms";
584	$info{identity}->[1]->{type} = "private";
585
586	$info{feature}->{http://jabber.org/protocol/disco#info} = 1;
587	$info{feature}->{http://jabber.org/protocol/muc#admin} = 1;
588
589	DiscoItemsRequest(jid=>string, - sends a disco#items request to
590	mode=>string, the jid passed as an argument.
591	timeout=>int) Returns a hash with the resulting
592	tree if mode is set to "block".
593
594	See DiscoItemsParse for the format
595	of the resulting tree.
596
597	See MODES above for using the mode
598	and timeout.
599
600	DiscoItemsParse(Net::Jabber::Query) - parses the query and
601	returns a hash ref
602	to the resulting tree:
603
604	$items{jid}->{node} = name;
605
606	$items{"proxy.server"}->{""} = "Bytestream Proxy Server";
607	$items{"conf.server"}->{"public"} = "Public Chatrooms";
608	$items{"conf.server"}->{"private"} = "Private Chatrooms";
609
610	=head2 Feature Negotiation Functions
611
612	FeatureNegRequest(jid=>string, - sends a feature negotiation to
613	features=>hash ref, the jid passed as an argument,
614	mode=>string, using the features specified.
615	timeout=>int) Returns a hash with the resulting
616	tree if mode is set to "block".
617
618	See DiscoInfoQuery for the format
619	of the features hash ref.
620
621	See DiscoInfoParse for the format
622	of the resulting tree.
623
624	See MODES above for using the mode
625	and timeout.
626
627	FeatureNegParse(Net::Jabber::Query) - parses the query and
628	returns a hash ref
629	to the resulting tree:
630
631	$features->{feat1} = ["opt1","opt2",...];
632	$features->{feat2} = ["optA","optB",...];
633	....
634
635	If this is a result:
636
637	$features->{feat1} = "opt2";
638	$features->{feat2} = "optA";
639	....
640
641	FeatureNeqQuery(hash ref) - takes a hash ref and turns it into a
642	feature negotiation query that you can
643	AddQuery into your packaet. The format
644	of the hash ref is as follows:
645
646	$features->{feat1} = ["opt1","opt2",...];
647	$features->{feat2} = ["optA","optB",...];
648	....
649
650	=head2 File Transfer Functions
651
652	FileTransferOffer(jid=>string, - sends a file transfer stream
653	sid=>string, initiation to the jid passed
654	filename=>string, as an argument. Returns the
655	mode=>string, method (if the users accepts),
656	timeout=>int) undef (if the user declines),
657	if the mode is set to "block".
658
659	See MODES above for using
660	the mode and timeout.
661
662	=head2 Last Functions
663
664	LastQuery(to=>string, - asks the jid specified for its last
665	mode=>string, activity. If the to is blank, then it
666	timeout=>int) queries the server. Returns a hash with
667	LastQuery() the various items set if mode is set to
668	"block":
669
670	$last{seconds} - Seconds since activity
671	$last{message} - Message for activity
672
673	See MODES above for using the mode
674	and timeout.
675
676	LastSend(to=>string, - sends the specified last to the specified jid.
677	hash) the hash is the seconds and message as shown
678	in the Net::Jabber::Query man page.
679
680	LastActivity() - returns the number of seconds since the last activity
681	by the user.
682
683	=head2 Multi-User Chat Functions
684
685	MUCJoin(room=>string, - Sends the appropriate MUC protocol to join
686	server=>string, the specified room with the specified nick.
687	nick=>string,
688	password=>string)
689
690	=head2 Register Functions
691
692	RegisterSendData(string\|JID, - takes the contents of the hash and
693	hash) builds a jabebr:x:data return packet
694	which it sends in a Net::Jabber::Query
695	jabber:iq:register namespace packet.
696	The first argument is the JID to send
697	the packet to. This function returns
698	an array that looks like this:
699
700	[ type , message ]
701
702	If type is "ok" then registration was
703	successful, otherwise message contains
704	a little more detail about the error.
705
706	=head2 RPC Functions
707
708	RPCParse(IQ object) - returns an array. The first argument tells
709	the status "ok" or "fault". The second
710	argument is an array if "ok", or a hash if
711	"fault".
712
713	RPCCall(to=>jid\|string, - takes the methodName and params,
714	methodName=>string, builds the RPC calls and sends it
715	params=>array, to the specified address. Returns
716	mode=>string, the above data from RPCParse.
717	timeout=>int)
718	See MODES above for using the mode
719	and timeout.
720
721	RPCResponse(to=>jid\|string, - generates a response back to
722	params=>array, the caller. If any part of
723	faultCode=>int, fault is specified, then it
724	faultString=>string) wins.
725
726
727	Note: To ensure that you get the correct type for a param sent
728	back, you can specify the type by prepending the type to
729	the value:
730
731	"i4:5" or "int:5"
732	"boolean:0"
733	"string:56"
734	"double:5.0"
735	"datetime:20020415T11:11:11"
736	"base64:...."
737
738	RPCSetCallBacks(method=>function, - sets the callback functions
739	method=>function, for the specified methods.
740	etc...) The method comes from the
741	<methodName/> and is case
742	sensitive. The single
743	arguemnt is a ref to an
744	array that contains the
745	<params/>. The function you
746	write should return one of two
747	things:
748
749	["ok", [...] ]
750
751	The [...] is a list of the
752	<params/> you want to return.
753
754	["fault", {faultCode=>1,
755	faultString=>...} ]
756
757	If you set the function to undef,
758	then the method is removed from
759	the list.
760
761	=head2 Search Functions
762
763	SearchRequest(to=>string, - send an <iq/> request to the specified
764	mode=>string, server/transport, if not specified it
765	timeout=>int) sends to the current active server.
766	SearchRequest() The function returns a hash that
767	contains the required fields. Here
768	is an example of the hash:
769
770	$hash{fields} - The raw fields from
771	the iq:register. To
772	be used if there is
773	no x:data in the
774	packet.
775	$hash{instructions} - How to fill out
776	the form.
777	$hash{form} - The new dynamic forms.
778
779	In $hash{form}, the fields that are
780	present are the required fields the
781	server needs.
782
783	See MODES above for using the mode
784	and timeout.
785
786	SearchSend(to=>string\|JID, - takes the contents of the hash and
787	hash) passes it to the SetSearch function
788	in the Net::Jabber::Query
789	jabber:iq:search namespace. And then
790	sends the packet.
791
792	SearchSendData(string\|JID, - takes the contents of the hash and
793	hash) builds a jabebr:x:data return packet
794	which it sends in a Net::Jabber::Query
795	jabber:iq:search namespace packet.
796	The first argument is the JID to send
797	the packet to.
798
799	=head2 Time Functions
800
801	TimeQuery(to=>string, - asks the jid specified for its localtime.
802	mode=>string, If the to is blank, then it queries the
803	timeout=>int) server. Returns a hash with the various
804	TimeQuery() items set if mode is set to "block":
805
806	$time{utc} - Time in UTC
807	$time{tz} - Timezone
808	$time{display} - Display string
809
810	See MODES above for using the mode
811	and timeout.
812
813	TimeSend(to=>string) - sends the current UTC time to the specified
814	jid.
815
816	=head2 Version Functions
817
818	VersionQuery(to=>string, - asks the jid specified for its
819	mode=>string, client version information. If the
820	timeout=>int) to is blank, then it queries the
821	VersionQuery() server. Returns ahash with the
822	various items set if mode is set to
823	"block":
824
825	$version{name} - Name
826	$version{ver} - Version
827	$version{os} - Operating System/
828	Platform
829
830	See MODES above for using the mode
831	and timeout.
832
833	VersionSend(to=>string, - sends the specified version information
834	name=>string, to the jid specified in the to.
835	ver=>string,
836	os=>string)
837
838	=head1 AUTHOR
839
840	Ryan Eatmon
841
842	=head1 COPYRIGHT
843
844	This module is free software; you can redistribute it and/or modify
845	it under the same terms as Perl itself.
846
847	=cut
848
849	use strict;
850	use Carp;
851	use vars qw($VERSION);
852
853	$VERSION = "2.0";
854
855	##############################################################################
856	# BuildObject takes a root tag and builds the correct object. NEWOBJECT is
857	# the table that maps tag to package. Override these, or provide new ones.
858	#-----------------------------------------------------------------------------
859	$Net::XMPP::Protocol::NEWOBJECT{'iq'} = "Net::Jabber::IQ";
860	$Net::XMPP::Protocol::NEWOBJECT{'message'} = "Net::Jabber::Message";
861	$Net::XMPP::Protocol::NEWOBJECT{'presence'} = "Net::Jabber::Presence";
862	$Net::XMPP::Protocol::NEWOBJECT{'jid'} = "Net::Jabber::JID";
863	##############################################################################
864
865	###############################################################################
866	#+-----------------------------------------------------------------------------
867	#\|
868	#\| Base API
869	#\|
870	#+-----------------------------------------------------------------------------
871	###############################################################################
872
873	###############################################################################
874	#
875	# Info - set the base information about this Jabber Client/Component for
876	# use in a default response.
877	#
878	###############################################################################
879	sub Info
880	{
881	my $self = shift;
882	my %args;
883	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
884
885	foreach my $arg (keys(%args))
886	{
887	$self->{INFO}->{$arg} = $args{$arg};
888	}
889	}
890
891
892	###############################################################################
893	#
894	# DefineNamespace - adds the namespace and corresponding functions onto the
895	# of available functions based on namespace.
896	#
897	# Deprecated in favor of AddNamespace
898	#
899	###############################################################################
900	sub DefineNamespace
901	{
902	my $self = shift;
903	my %args;
904	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
905
906	croak("You must specify xmlns=>'' for the function call to DefineNamespace")
907	if !exists($args{xmlns});
908	croak("You must specify type=>'' for the function call to DefineNamespace")
909	if !exists($args{type});
910	croak("You must specify functions=>'' for the function call to DefineNamespace")
911	if !exists($args{functions});
912
913	my %xpath;
914
915	my $tag;
916	if (exists($args{tag}))
917	{
918	$tag = $args{tag};
919	}
920	else
921	{
922	$tag = "x" if ($args{type} eq "X");
923	$tag = "query" if ($args{type} eq "Query");
924	}
925
926	foreach my $function (@{$args{functions}})
927	{
928	my %tempHash = %{$function};
929	my %funcHash;
930	foreach my $func (keys(%tempHash))
931	{
932	$funcHash{lc($func)} = $tempHash{$func};
933	}
934
935	croak("You must specify name=>'' for each function in call to DefineNamespace")
936	if !exists($funcHash{name});
937
938	my $name = delete($funcHash{name});
939
940	if (!exists($funcHash{set}) && exists($funcHash{get}))
941	{
942	croak("The DefineNamespace arugments have changed, and I cannot determine the\nnew values automatically for name($name). Please read the man page\nfor Net::Jabber::Namespaces. I apologize for this incompatability.\n");
943	}
944
945	if (exists($funcHash{type}) \|\| exists($funcHash{path}) \|\|
946	exists($funcHash{child}) \|\| exists($funcHash{calls}))
947	{
948
949	foreach my $type (keys(%funcHash))
950	{
951	if ($type eq "child")
952	{
953	$xpath{$name}->{$type}->{ns} = $funcHash{$type}->[1];
954	my $i = 2;
955	while( $i <= $#{$funcHash{$type}} )
956	{
957	if ($funcHash{$type}->[$i] eq "__netjabber__:skip_xmlns")
958	{
959	$xpath{$name}->{$type}->{skip_xmlns} = 1;
960	}
961
962	if ($funcHash{$type}->[$i] eq "__netjabber__:specifyname")
963	{
964	$xpath{$name}->{$type}->{specify_name} = 1;
965	$i++;
966	$xpath{$name}->{$type}->{tag} = $funcHash{$type}->[$i+1];
967	}
968
969	$i++;
970	}
971	}
972	else
973	{
974	$xpath{$name}->{$type} = $funcHash{$type};
975	}
976	}
977	next;
978	}
979
980	my $type = $funcHash{set}->[0];
981	my $xpath = $funcHash{set}->[1];
982	if (exists($funcHash{hash}))
983	{
984	$xpath = "text()" if ($funcHash{hash} eq "data");
985	$xpath .= "/text()" if ($funcHash{hash} eq "child-data");
986	$xpath = "\@$xpath" if ($funcHash{hash} eq "att");
987	$xpath = "$1/\@$2" if ($funcHash{hash} =~ /^att-(\S+)-(.+)$/);
988	}
989
990	if ($type eq "master")
991	{
992	$xpath{$name}->{type} = $type;
993	next;
994	}
995
996	if ($type eq "scalar")
997	{
998	$xpath{$name}->{path} = $xpath;
999	next;
1000	}
1001
1002	if ($type eq "flag")
1003	{
1004	$xpath{$name}->{type} = 'flag';
1005	$xpath{$name}->{path} = $xpath;
1006	next;
1007	}
1008
1009	if (($funcHash{hash} eq "child-add") && exists($funcHash{add}))
1010	{
1011	$xpath{$name}->{type} = "node";
1012	$xpath{$name}->{path} = $funcHash{add}->[3];
1013	$xpath{$name}->{child}->{ns} = $funcHash{add}->[1];
1014	$xpath{$name}->{calls} = [ 'Add' ];
1015	next;
1016	}
1017	}
1018
1019	$self->AddNamespace(ns => $args{xmlns},
1020	tag => $tag,
1021	xpath => \%xpath );
1022	}
1023
1024	###############################################################################
1025	#
1026	# AgentsGet - Sends an empty IQ to the server/transport to request that the
1027	# list of supported Agents be sent to them. Returns a hash
1028	# containing the values for the agents.
1029	#
1030	###############################################################################
1031	sub AgentsGet
1032	{
1033	my $self = shift;
1034
1035	my $iq = $self->_iq();
1036	$iq->SetIQ(@_);
1037	$iq->SetIQ(type=>"get");
1038	my $query = $iq->NewQuery("jabber:iq:agents");
1039
1040	$iq = $self->SendAndReceiveWithID($iq);
1041
1042	return unless defined($iq);
1043
1044	$query = $iq->GetQuery();
1045	my @agents = $query->GetAgents();
1046
1047	my %agents;
1048	my $count = 0;
1049	foreach my $agent (@agents)
1050	{
1051	my $jid = $agent->GetJID();
1052	$agents{$jid}->{name} = $agent->GetName();
1053	$agents{$jid}->{description} = $agent->GetDescription();
1054	$agents{$jid}->{transport} = $agent->GetTransport();
1055	$agents{$jid}->{service} = $agent->GetService();
1056	$agents{$jid}->{register} = $agent->DefinedRegister();
1057	$agents{$jid}->{search} = $agent->DefinedSearch();
1058	$agents{$jid}->{groupchat} = $agent->DefinedGroupChat();
1059	$agents{$jid}->{agents} = $agent->DefinedAgents();
1060	$agents{$jid}->{order} = $count++;
1061	}
1062
1063	return %agents;
1064	}
1065
1066
1067	###############################################################################
1068	#
1069	# BrowseRequest - requests the browse information from the specified JID.
1070	#
1071	###############################################################################
1072	sub BrowseRequest
1073	{
1074	my $self = shift;
1075	my %args;
1076	$args{mode} = "block";
1077	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1078
1079	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1080
1081	my $iq = $self->_iq();
1082	$iq->SetIQ(to=>$args{jid},
1083	type=>"get");
1084	my $query = $iq->NewQuery("jabber:iq:browse");
1085
1086	#--------------------------------------------------------------------------
1087	# Send the IQ with the next available ID and wait for a reply with that
1088	# id to be received. Then grab the IQ reply.
1089	#--------------------------------------------------------------------------
1090	if ($args{mode} eq "passthru")
1091	{
1092	my $id = $self->UniqueID();
1093	$iq->SetIQ(id=>$id);
1094	$self->Send($iq);
1095	return $id;
1096	}
1097
1098	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1099
1100	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1101
1102	#--------------------------------------------------------------------------
1103	# Check if there was an error.
1104	#--------------------------------------------------------------------------
1105	return unless defined($iq);
1106	if ($iq->GetType() eq "error")
1107	{
1108	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1109	return;
1110	}
1111
1112	$query = $iq->GetQuery();
1113
1114	if (defined($query))
1115	{
1116	my %browse = %{$self->BrowseParse($query)};
1117	return %browse;
1118	}
1119	else
1120	{
1121	return;
1122	}
1123	}
1124
1125
1126	###############################################################################
1127	#
1128	# BrowseParse - helper function for BrowseRequest to convert the object
1129	# tree into a hash for better consumption.
1130	#
1131	###############################################################################
1132	sub BrowseParse
1133	{
1134	my $self = shift;
1135	my $item = shift;
1136	my %browse;
1137
1138	if ($item->DefinedCategory())
1139	{
1140	$browse{category} = $item->GetCategory();
1141	}
1142	else
1143	{
1144	$browse{category} = $item->GetTag();
1145	}
1146	$browse{type} = $item->GetType();
1147	$browse{name} = $item->GetName();
1148	$browse{jid} = $item->GetJID();
1149	$browse{ns} = [ $item->GetNS() ];
1150
1151	foreach my $subitem ($item->GetItems())
1152	{
1153	my ($subbrowse) = $self->BrowseParse($subitem);
1154	push(@{$browse{children}},$subbrowse);
1155	}
1156
1157	return \%browse;
1158	}
1159
1160
1161	###############################################################################
1162	#
1163	# BrowseDBDelete - delete the JID from the DB completely.
1164	#
1165	###############################################################################
1166	sub BrowseDBDelete
1167	{
1168	my $self = shift;
1169	my ($jid) = @_;
1170
1171	my $indexJID = $jid;
1172	$indexJID = $jid->GetJID() if (ref($jid) eq "Net::Jabber::JID");
1173
1174	return if !exists($self->{BROWSEDB}->{$indexJID});
1175	delete($self->{BROWSEDB}->{$indexJID});
1176	$self->{DEBUG}->Log1("BrowseDBDelete: delete ",$indexJID," from the DB");
1177	}
1178
1179
1180	###############################################################################
1181	#
1182	# BrowseDBQuery - retrieve the last Net::Jabber::Browse received with
1183	# the highest priority.
1184	#
1185	###############################################################################
1186	sub BrowseDBQuery
1187	{
1188	my $self = shift;
1189	my %args;
1190	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1191
1192	$args{timeout} = 10 unless exists($args{timeout});
1193
1194	my $indexJID = $args{jid};
1195	$indexJID = $args{jid}->GetJID() if (ref($args{jid}) eq "Net::Jabber::JID");
1196
1197	if ((exists($args{refresh}) && ($args{refresh} eq "1")) \|\|
1198	(!exists($self->{BROWSEDB}->{$indexJID})))
1199	{
1200	my %browse = $self->BrowseRequest(jid=>$args{jid},
1201	timeout=>$args{timeout});
1202
1203	$self->{BROWSEDB}->{$indexJID} = \%browse;
1204	}
1205	return %{$self->{BROWSEDB}->{$indexJID}};
1206	}
1207
1208
1209	###############################################################################
1210	#
1211	# ByteStreamsProxyRequest - This queries a proxy server to get a list of
1212	#
1213	###############################################################################
1214	sub ByteStreamsProxyRequest
1215	{
1216	my $self = shift;
1217	my %args;
1218	$args{mode} = "block";
1219	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1220
1221	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1222
1223	my $iq = $self->_iq();
1224	$iq->SetIQ(to=>$args{jid},
1225	type=>"get");
1226	my $query = $iq->NewQuery("http://jabber.org/protocol/bytestreams");
1227
1228	#--------------------------------------------------------------------------
1229	# Send the IQ with the next available ID and wait for a reply with that
1230	# id to be received. Then grab the IQ reply.
1231	#--------------------------------------------------------------------------
1232	if ($args{mode} eq "passthru")
1233	{
1234	my $id = $self->UniqueID();
1235	$iq->SetIQ(id=>$id);
1236	$self->Send($iq);
1237	return $id;
1238	}
1239
1240	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1241
1242	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1243
1244	#--------------------------------------------------------------------------
1245	# Check if there was an error.
1246	#--------------------------------------------------------------------------
1247	return unless defined($iq);
1248	if ($iq->GetType() eq "error")
1249	{
1250	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1251	return;
1252	}
1253
1254	$query = $iq->GetQuery();
1255
1256	if (defined($query))
1257	{
1258	my @hosts = @{$self->ByteStreamsProxyParse($query)};
1259	return @hosts;
1260	}
1261	else
1262	{
1263	return;
1264	}
1265	}
1266
1267
1268	###############################################################################
1269	#
1270	# ByteStreamsProxyParse - helper function for ByteStreamProxyRequest to convert
1271	# the object tree into a hash for better consumption.
1272	#
1273	###############################################################################
1274	sub ByteStreamsProxyParse
1275	{
1276	my $self = shift;
1277	my $item = shift;
1278
1279	my @hosts;
1280
1281	foreach my $host ($item->GetStreamHosts())
1282	{
1283	my %host;
1284	$host{jid} = $host->GetJID();
1285	$host{host} = $host->GetHost() if $host->DefinedHost();
1286	$host{port} = $host->GetPort() if $host->DefinedPort();
1287	$host{zeroconf} = $host->GetZeroConf() if $host->DefinedZeroConf();
1288
1289	push(@hosts,\%host);
1290	}
1291
1292	return \@hosts;
1293	}
1294
1295
1296	###############################################################################
1297	#
1298	# ByteStreamsProxyActivate - This tells a proxy to activate the connection
1299	#
1300	###############################################################################
1301	sub ByteStreamsProxyActivate
1302	{
1303	my $self = shift;
1304	my %args;
1305	$args{mode} = "block";
1306	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1307
1308	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1309
1310	my $iq = $self->_iq();
1311	$iq->SetIQ(to=>$args{jid},
1312	type=>"set");
1313	my $query = $iq->NewQuery("http://jabber.org/protocol/bytestreams");
1314	$query->SetByteStreams(sid=>$args{sid},
1315	activate=>(ref($args{recipient}) eq "Net::Jabber::JID" ? $args{recipient}->GetJID("full") : $args{recipient})
1316	);
1317
1318	#--------------------------------------------------------------------------
1319	# Send the IQ with the next available ID and wait for a reply with that
1320	# id to be received. Then grab the IQ reply.
1321	#--------------------------------------------------------------------------
1322	if ($args{mode} eq "passthru")
1323	{
1324	my $id = $self->UniqueID();
1325	$iq->SetIQ(id=>$id);
1326	$self->Send($iq);
1327	return $id;
1328	}
1329
1330	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1331
1332	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1333
1334	#--------------------------------------------------------------------------
1335	# Check if there was an error.
1336	#--------------------------------------------------------------------------
1337	return unless defined($iq);
1338	if ($iq->GetType() eq "error")
1339	{
1340	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1341	return;
1342	}
1343
1344	return 1;
1345	}
1346
1347
1348	###############################################################################
1349	#
1350	# ByteStreamsOffer - This offers a recipient a list of stream hosts to pick
1351	# from.
1352	#
1353	###############################################################################
1354	sub ByteStreamsOffer
1355	{
1356	my $self = shift;
1357	my %args;
1358	$args{mode} = "block";
1359	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1360
1361	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1362
1363	my $iq = $self->_iq();
1364	$iq->SetIQ(to=>$args{jid},
1365	type=>"set");
1366	my $query = $iq->NewQuery("http://jabber.org/protocol/bytestreams");
1367
1368	$query->SetByteStreams(sid=>$args{sid});
1369
1370	foreach my $host (@{$args{streamhosts}})
1371	{
1372	$query->AddStreamHost(jid=>$host->{jid},
1373	(exists($host->{host}) ? (host=>$host->{host}) : ()),
1374	(exists($host->{port}) ? (port=>$host->{port}) : ()),
1375	(exists($host->{zeroconf}) ? (zeroconf=>$host->{zeroconf}) : ()),
1376	);
1377	}
1378
1379	#--------------------------------------------------------------------------
1380	# Send the IQ with the next available ID and wait for a reply with that
1381	# id to be received. Then grab the IQ reply.
1382	#--------------------------------------------------------------------------
1383	if ($args{mode} eq "passthru")
1384	{
1385	my $id = $self->UniqueID();
1386	$iq->SetIQ(id=>$id);
1387	$self->Send($iq);
1388	return $id;
1389	}
1390
1391	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1392
1393	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1394
1395	#--------------------------------------------------------------------------
1396	# Check if there was an error.
1397	#--------------------------------------------------------------------------
1398	return unless defined($iq);
1399	if ($iq->GetType() eq "error")
1400	{
1401	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1402	return;
1403	}
1404
1405	$query = $iq->GetQuery();
1406
1407	if (defined($query))
1408	{
1409	return $query->GetStreamHostUsedJID();
1410	}
1411	else
1412	{
1413	return;
1414	}
1415	}
1416
1417
1418	###############################################################################
1419	#
1420	# DiscoInfoRequest - requests the disco information from the specified JID.
1421	#
1422	###############################################################################
1423	sub DiscoInfoRequest
1424	{
1425	my $self = shift;
1426	my %args;
1427	$args{mode} = "block";
1428	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1429
1430	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1431
1432	my $iq = $self->_iq();
1433	$iq->SetIQ(to=>$args{jid},
1434	type=>"get");
1435	my $query = $iq->NewQuery("http://jabber.org/protocol/disco#info");
1436	$query->SetDiscoInfo(node=>$args{node}) if exists($args{node});
1437
1438	#--------------------------------------------------------------------------
1439	# Send the IQ with the next available ID and wait for a reply with that
1440	# id to be received. Then grab the IQ reply.
1441	#--------------------------------------------------------------------------
1442	if ($args{mode} eq "passthru")
1443	{
1444	my $id = $self->UniqueID();
1445	$iq->SetIQ(id=>$id);
1446	$self->Send($iq);
1447	return $id;
1448	}
1449
1450	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1451
1452	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1453
1454	#--------------------------------------------------------------------------
1455	# Check if there was an error.
1456	#--------------------------------------------------------------------------
1457	return unless defined($iq);
1458	if ($iq->GetType() eq "error")
1459	{
1460	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1461	return;
1462	}
1463	return unless $iq->DefinedQuery();
1464
1465	$query = $iq->GetQuery();
1466
1467	return %{$self->DiscoInfoParse($query)};
1468	}
1469
1470
1471	###############################################################################
1472	#
1473	# DiscoInfoParse - helper function for DiscoInfoRequest to convert the object
1474	# tree into a hash for better consumption.
1475	#
1476	###############################################################################
1477	sub DiscoInfoParse
1478	{
1479	my $self = shift;
1480	my $item = shift;
1481
1482	my %disco;
1483
1484	foreach my $ident ($item->GetIdentities())
1485	{
1486	my %identity;
1487	$identity{category} = $ident->GetCategory();
1488	$identity{name} = $ident->GetName();
1489	$identity{type} = $ident->GetType();
1490	push(@{$disco{identity}},\%identity);
1491	}
1492
1493	foreach my $feat ($item->GetFeatures())
1494	{
1495	$disco{feature}->{$feat->GetVar()} = 1;
1496	}
1497
1498	return \%disco;
1499	}
1500
1501
1502	###############################################################################
1503	#
1504	# DiscoItemsRequest - requests the disco information from the specified JID.
1505	#
1506	###############################################################################
1507	sub DiscoItemsRequest
1508	{
1509	my $self = shift;
1510	my %args;
1511	$args{mode} = "block";
1512	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1513
1514	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1515
1516	my $iq = $self->_iq();
1517	$iq->SetIQ(to=>$args{jid},
1518	type=>"get");
1519	my $query = $iq->NewQuery("http://jabber.org/protocol/disco#items");
1520	$query->SetDiscoItems(node=>$args{node}) if exists($args{node});
1521
1522	#--------------------------------------------------------------------------
1523	# Send the IQ with the next available ID and wait for a reply with that
1524	# id to be received. Then grab the IQ reply.
1525	#--------------------------------------------------------------------------
1526	if ($args{mode} eq "passthru")
1527	{
1528	my $id = $self->UniqueID();
1529	$iq->SetIQ(id=>$id);
1530	$self->Send($iq);
1531	return $id;
1532	}
1533
1534	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1535
1536	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1537
1538	#--------------------------------------------------------------------------
1539	# Check if there was an error.
1540	#--------------------------------------------------------------------------
1541	return unless defined($iq);
1542	if ($iq->GetType() eq "error")
1543	{
1544	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1545	return;
1546	}
1547
1548	$query = $iq->GetQuery();
1549
1550	if (defined($query))
1551	{
1552	my %disco = %{$self->DiscoItemsParse($query)};
1553	return %disco;
1554	}
1555	else
1556	{
1557	return;
1558	}
1559	}
1560
1561
1562	###############################################################################
1563	#
1564	# DiscoItemsParse - helper function for DiscoItemsRequest to convert the object
1565	# tree into a hash for better consumption.
1566	#
1567	###############################################################################
1568	sub DiscoItemsParse
1569	{
1570	my $self = shift;
1571	my $item = shift;
1572
1573	my %disco;
1574
1575	foreach my $item ($item->GetItems())
1576	{
1577	$disco{$item->GetJID()}->{$item->GetNode()} = $item->GetName();
1578	}
1579
1580	return \%disco;
1581	}
1582
1583
1584	###############################################################################
1585	#
1586	# FeatureNegRequest - requests a feature negotiation from the specified JID.
1587	#
1588	###############################################################################
1589	sub FeatureNegRequest
1590	{
1591	my $self = shift;
1592	my %args;
1593	$args{mode} = "block";
1594	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1595
1596	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1597
1598	my $iq = $self->_iq();
1599	$iq->SetIQ(to=>$args{jid},
1600	type=>"get");
1601
1602	my $query = $self->FeatureNegQuery($args{features});
1603
1604	$iq->AddQuery($query);
1605
1606	#--------------------------------------------------------------------------
1607	# Send the IQ with the next available ID and wait for a reply with that
1608	# id to be received. Then grab the IQ reply.
1609	#--------------------------------------------------------------------------
1610	if ($args{mode} eq "passthru")
1611	{
1612	my $id = $self->UniqueID();
1613	$iq->SetIQ(id=>$id);
1614	$self->Send($iq);
1615	return $id;
1616	}
1617
1618	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1619
1620	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1621
1622	#--------------------------------------------------------------------------
1623	# Check if there was an error.
1624	#--------------------------------------------------------------------------
1625	return unless defined($iq);
1626	if ($iq->GetType() eq "error")
1627	{
1628	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1629	return;
1630	}
1631
1632	$query = $iq->GetQuery();
1633
1634	if (defined($query))
1635	{
1636	my %feats = %{$self->FeatureNegParse($query)};
1637	return %feats;
1638	}
1639	else
1640	{
1641	return;
1642	}
1643	}
1644
1645	#xxx fneg needs to reutrn a type='submit' on the x:data in a result
1646
1647
1648	###############################################################################
1649	#
1650	# FeatureNegQuery - given a feature hash, return a query that contains it.
1651	#
1652	###############################################################################
1653	sub FeatureNegQuery
1654	{
1655	my $self = shift;
1656	my $features = shift;
1657
1658	my $tag = "query";
1659	$tag = $Net::Jabber::Query::TAGS{'http://jabber.org/protocol/feature-neg'}
1660	if exists($Net::Jabber::Query::TAGS{'http://jabber.org/protocol/feature-neg'});
1661
1662	my $query = Net::Jabber::Query->new($tag);
1663	$query->SetXMLNS("http://jabber.org/protocol/feature-neg");
1664	my $xdata = $query->NewX("jabber:x:data");
1665
1666	foreach my $feature (keys(%{$features}))
1667	{
1668	my $field = $xdata->AddField(type=>"list-single",
1669	var=>$feature);
1670	foreach my $value (@{$features->{$feature}})
1671	{
1672	$field->AddOption(value=>$value);
1673	}
1674	}
1675
1676	return $query;
1677	}
1678
1679
1680	###############################################################################
1681	#
1682	# FeatureNegParse - helper function for FeatureNegRequest to convert the object
1683	# tree into a hash for better consumption.
1684	#
1685	###############################################################################
1686	sub FeatureNegParse
1687	{
1688	my $self = shift;
1689	my $item = shift;
1690
1691	my %feats;
1692
1693	my $xdata = $item->GetX("jabber:x:data");
1694
1695	foreach my $field ($xdata->GetFields())
1696	{
1697	my @options;
1698
1699	foreach my $option ($field->GetOptions())
1700	{
1701	push(@options,$option->GetValue());
1702	}
1703
1704	if ($#options == -1)
1705	{
1706
1707	$feats{$field->GetVar()} = $field->GetValue();
1708	}
1709	else
1710	{
1711	$feats{$field->GetVar()} = \@options;
1712	}
1713	}
1714
1715	return \%feats;
1716	}
1717
1718	#XXX - need a feature-neg answer function...
1719
1720	###############################################################################
1721	#
1722	# FileTransferOffer - offer a file transfer JEP-95
1723	#
1724	###############################################################################
1725	sub FileTransferOffer
1726	{
1727	my $self = shift;
1728	my %args;
1729	$args{mode} = "block";
1730	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1731
1732	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1733
1734	my $iq = $self->_iq();
1735	$iq->SetIQ(to=>$args{jid},
1736	type=>"set");
1737	my $query = $iq->NewQuery("http://jabber.org/protocol/si");
1738	my $profile = $query->NewQuery("http://jabber.org/protocol/si/profile/file-transfer");
1739
1740	# XXX support hashing via MD5
1741	# XXX support date via JEP-82
1742
1743	my ($filename) = ($args{filename} =~ /\/?([^\/]+)$/);
1744
1745	$profile->SetFile(name=>$filename,
1746	size=>(-s $args{filename})
1747	);
1748
1749	$profile->SetFile(desc=>$args{desc}) if exists($args{desc});
1750
1751	$query->SetStream(mimetype=>(-B $args{filename} ?
1752	"application/octect-stream" :
1753	"text/plain"
1754	),
1755	id=>$args{sid},
1756	profile=>"http://jabber.org/protocol/si/profile/file-transfer"
1757	);
1758
1759	if (!exists($args{skip_methods}))
1760	{
1761	if ($#{$args{methods}} == -1)
1762	{
1763	print STDERR "You did not provide any valid methods for file transfer.\n";
1764	return;
1765	}
1766
1767	my $fneg = $self->FeatureNegQuery({'stream-method'=>$args{methods}});
1768
1769	$query->AddQuery($fneg);
1770	}
1771
1772	#--------------------------------------------------------------------------
1773	# Send the IQ with the next available ID and wait for a reply with that
1774	# id to be received. Then grab the IQ reply.
1775	#--------------------------------------------------------------------------
1776	if ($args{mode} eq "passthru")
1777	{
1778	my $id = $self->UniqueID();
1779	$iq->SetIQ(id=>$id);
1780	$self->Send($iq);
1781	return $id;
1782	}
1783
1784	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1785
1786	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1787
1788	#--------------------------------------------------------------------------
1789	# Check if there was an error.
1790	#--------------------------------------------------------------------------
1791	return unless defined($iq);
1792	if ($iq->GetType() eq "error")
1793	{
1794	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1795	return;
1796	}
1797
1798	$query = $iq->GetQuery();
1799
1800	if (defined($query))
1801	{
1802	my @fneg = $query->GetQuery("http://jabber.org/protocol/feature-neg");
1803	my @xdata = $fneg[0]->GetX("jabber:x:data");
1804	my @fields = $xdata[0]->GetFields();
1805	return $fields[0]->GetValue();
1806	# XXX need better error handling
1807	}
1808	else
1809	{
1810	return;
1811	}
1812	}
1813
1814
1815	###############################################################################
1816	#
1817	# TreeTransferOffer - offer a file transfer JEP-95
1818	#
1819	###############################################################################
1820	sub TreeTransferOffer
1821	{
1822	my $self = shift;
1823	my %args;
1824	$args{mode} = "block";
1825	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1826
1827	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1828
1829	my $iq = $self->_iq();
1830	$iq->SetIQ(to=>$args{jid},
1831	type=>"set");
1832	my $query = $iq->NewQuery("http://jabber.org/protocol/si");
1833	my $profile = $query->NewQuery("http://jabber.org/protocol/si/profile/tree-transfer");
1834
1835	my ($root) = ($args{directory} =~ /\/?([^\/]+)$/);
1836
1837	my $rootDir = $profile->AddDirectory(name=>$root);
1838
1839	my %tree;
1840	$tree{counter} = 0;
1841	$self->TreeTransferDescend($args{sidbase},
1842	$args{directory},
1843	$rootDir,
1844	\%tree
1845	);
1846
1847	$profile->SetTree(numfiles=>$tree{counter},
1848	size=>$tree{size}
1849	);
1850
1851	$query->SetStream(id=>$args{sidbase},
1852	profile=>"http://jabber.org/protocol/si/profile/tree-transfer"
1853	);
1854
1855	if ($#{$args{methods}} == -1)
1856	{
1857	print STDERR "You did not provide any valid methods for the tree transfer.\n";
1858	return;
1859	}
1860
1861	my $fneg = $self->FeatureNegQuery({'stream-method'=>$args{methods}});
1862
1863	$query->AddQuery($fneg);
1864
1865	#--------------------------------------------------------------------------
1866	# Send the IQ with the next available ID and wait for a reply with that
1867	# id to be received. Then grab the IQ reply.
1868	#--------------------------------------------------------------------------
1869	if ($args{mode} eq "passthru")
1870	{
1871	my $id = $self->UniqueID();
1872	$iq->SetIQ(id=>$id);
1873	$self->Send($iq);
1874	$tree{id} = $id;
1875	return %tree;
1876	}
1877
1878	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1879
1880	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1881
1882	#--------------------------------------------------------------------------
1883	# Check if there was an error.
1884	#--------------------------------------------------------------------------
1885	return unless defined($iq);
1886	if ($iq->GetType() eq "error")
1887	{
1888	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
1889	return;
1890	}
1891
1892	$query = $iq->GetQuery();
1893
1894	if (defined($query))
1895	{
1896	my @fneg = $query->GetQuery("http://jabber.org/protocol/feature-neg");
1897	my @xdata = $fneg[0]->GetX("jabber:x:data");
1898	my @fields = $xdata[0]->GetFields();
1899	return $fields[0]->GetValue();
1900	# XXX need better error handling
1901	}
1902	else
1903	{
1904	return;
1905	}
1906	}
1907
1908
1909	###############################################################################
1910	#
1911	# TreeTransferDescend - descend a directory structure and build the packet.
1912	#
1913	###############################################################################
1914	sub TreeTransferDescend
1915	{
1916	my $self = shift;
1917	my $sidbase = shift;
1918	my $path = shift;
1919	my $parent = shift;
1920	my $tree = shift;
1921
1922	$tree->{size} += (-s $path);
1923
1924	opendir(DIR, $path);
1925	foreach my $file ( sort {$a cmp $b} readdir(DIR) )
1926	{
1927	next if ($file =~ /^\.\.?$/);
1928
1929	if (-d "$path/$file")
1930	{
1931	my $tempParent = $parent->AddDirectory(name=>$file);
1932	$self->TreeTransferDescend($sidbase,
1933	"$path/$file",
1934	$tempParent,
1935	$tree
1936	);
1937	}
1938	else
1939	{
1940	$tree->{size} += (-s "$path/$file");
1941
1942	$tree->{tree}->{"$path/$file"}->{order} = $tree->{counter};
1943	$tree->{tree}->{"$path/$file"}->{sid} =
1944	$sidbase."-".$tree->{counter};
1945	$tree->{tree}->{"$path/$file"}->{name} = $file;
1946
1947	$parent->AddFile(name=>$tree->{tree}->{"$path/$file"}->{name},
1948	sid=>$tree->{tree}->{"$path/$file"}->{sid});
1949	$tree->{counter}++;
1950	}
1951	}
1952	closedir(DIR);
1953	}
1954
1955
1956	###############################################################################
1957	#
1958	# LastQuery - Sends an iq:last query to either the server or the specified
1959	# JID.
1960	#
1961	###############################################################################
1962	sub LastQuery
1963	{
1964	my $self = shift;
1965	my %args;
1966	$args{mode} = "passthru";
1967	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
1968
1969	$args{waitforid} = 0 unless exists($args{waitforid});
1970	my $waitforid = delete($args{waitforid});
1971	$args{mode} = "block" if $waitforid;
1972
1973	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
1974
1975	my $iq = $self->_iq();
1976	$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
1977	$iq->SetIQ(type=>'get');
1978	my $last = $iq->NewQuery("jabber:iq:last");
1979
1980	if ($args{mode} eq "passthru")
1981	{
1982	my $id = $self->UniqueID();
1983	$iq->SetIQ(id=>$id);
1984	$self->Send($iq);
1985	return $id;
1986	}
1987
1988	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
1989
1990	$iq = $self->SendAndReceiveWithID($iq,$timeout);
1991
1992	return unless defined($iq);
1993
1994	$last = $iq->GetQuery();
1995
1996	return unless defined($last);
1997
1998	return $last->GetLast();
1999	}
2000
2001
2002	###############################################################################
2003	#
2004	# LastSend - sends an iq:last packet to the specified user.
2005	#
2006	###############################################################################
2007	sub LastSend
2008	{
2009	my $self = shift;
2010	my %args;
2011	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2012
2013	$args{ignoreactivity} = 0 unless exists($args{ignoreactivity});
2014	my $ignoreActivity = delete($args{ignoreactivity});
2015
2016	my $iq = $self->_iq();
2017	$iq->SetIQ(to=>delete($args{to}),
2018	type=>'result');
2019	my $last = $iq->NewQuery("jabber:iq:last");
2020	$last->SetLast(%args);
2021
2022	$self->Send($iq,$ignoreActivity);
2023	}
2024
2025
2026	###############################################################################
2027	#
2028	# LastActivity - returns number of seconds since the last activity.
2029	#
2030	###############################################################################
2031	sub LastActivity
2032	{
2033	my $self = shift;
2034
2035	return (time - $self->{STREAM}->LastActivity($self->{SESSION}->{id}));
2036	}
2037
2038
2039	###############################################################################
2040	#
2041	# RegisterSendData - This is a self contained function to send a register iq
2042	# tag with an id. It uses the jabber:x:data method to
2043	# return the data.
2044	#
2045	###############################################################################
2046	sub RegisterSendData
2047	{
2048	my $self = shift;
2049	my $to = shift;
2050	my %args;
2051	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2052
2053	#--------------------------------------------------------------------------
2054	# Create a Net::Jabber::IQ object to send to the server
2055	#--------------------------------------------------------------------------
2056	my $iq = $self->_iq();
2057	$iq->SetIQ(to=>$to) if (defined($to) && ($to ne ""));
2058	$iq->SetIQ(type=>"set");
2059	my $iqRegister = $iq->NewQuery("jabber:iq:register");
2060	my $xForm = $iqRegister->NewX("jabber:x:data");
2061	foreach my $var (keys(%args))
2062	{
2063	next if ($args{$var} eq "");
2064	$xForm->AddField(var=>$var,
2065	value=>$args{$var}
2066	);
2067	}
2068
2069	#--------------------------------------------------------------------------
2070	# Send the IQ with the next available ID and wait for a reply with that
2071	# id to be received. Then grab the IQ reply.
2072	#--------------------------------------------------------------------------
2073	$iq = $self->SendAndReceiveWithID($iq);
2074
2075	#--------------------------------------------------------------------------
2076	# From the reply IQ determine if we were successful or not. If yes then
2077	# return "". If no then return error string from the reply.
2078	#--------------------------------------------------------------------------
2079	return unless defined($iq);
2080	return ( $iq->GetErrorCode() , $iq->GetError() )
2081	if ($iq->GetType() eq "error");
2082	return ("ok","");
2083	}
2084
2085
2086	###############################################################################
2087	#
2088	# RPCSetCallBacks - place to register a callback for RPC calls. This is
2089	# used in conjunction with the default IQ callback.
2090	#
2091	###############################################################################
2092	sub RPCSetCallBacks
2093	{
2094	my $self = shift;
2095	while($#_ >= 0) {
2096	my $func = pop(@_);
2097	my $method = pop(@_);
2098	$self->{DEBUG}->Log2("RPCSetCallBacks: method($method) func($func)");
2099	if (defined($func))
2100	{
2101	$self->{RPCCB}{$method} = $func;
2102	}
2103	else
2104	{
2105	delete($self->{RPCCB}{$method});
2106	}
2107	}
2108	}
2109
2110
2111	###############################################################################
2112	#
2113	# RPCCall - Make an RPC call to the specified JID.
2114	#
2115	###############################################################################
2116	sub RPCCall
2117	{
2118	my $self = shift;
2119	my %args;
2120	$args{mode} = "block";
2121	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2122
2123	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
2124
2125	my $iq = $self->_iq();
2126	$iq->SetIQ(type=>"set",
2127	to=>delete($args{to}));
2128	$iq->AddQuery($self->RPCEncode(type=>"methodCall",
2129	%args));
2130
2131	if ($args{mode} eq "passthru")
2132	{
2133	my $id = $self->UniqueID();
2134	$iq->SetIQ(id=>$id);
2135	$self->Send($iq);
2136	return $id;
2137	}
2138
2139	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
2140
2141	$iq = $self->SendAndReceiveWithID($iq,$timeout);
2142
2143	return unless defined($iq);
2144
2145	return $self->RPCParse($iq);
2146	}
2147
2148
2149	###############################################################################
2150	#
2151	# RPCResponse - Send back an RPC response, or fault, to the specified JID.
2152	#
2153	###############################################################################
2154	sub RPCResponse
2155	{
2156	my $self = shift;
2157	my %args;
2158	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2159
2160	my $iq = $self->_iq();
2161	$iq->SetIQ(type=>"result",
2162	to=>delete($args{to}));
2163	$iq->AddQuery($self->RPCEncode(type=>"methodResponse",
2164	%args));
2165
2166	$iq = $self->SendAndReceiveWithID($iq);
2167	return unless defined($iq);
2168
2169	return $self->RPCParse($iq);
2170	}
2171
2172
2173	###############################################################################
2174	#
2175	# RPCEncode - Returns a Net::Jabber::Query with the arguments encoded for the
2176	# RPC packet.
2177	#
2178	###############################################################################
2179	sub RPCEncode
2180	{
2181	my $self = shift;
2182	my %args;
2183	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2184
2185	my $query = Net::Jabber::Stanza->new("query");
2186	$query->SetXMLNS("jabber:iq:rpc");
2187
2188	my $source;
2189
2190	if ($args{type} eq "methodCall")
2191	{
2192	$source = $query->AddMethodCall();
2193	$source->SetMethodName($args{methodname});
2194	}
2195
2196	if ($args{type} eq "methodResponse")
2197	{
2198	$source = $query->AddMethodResponse();
2199	}
2200
2201	if (exists($args{faultcode}) \|\| exists($args{faultstring}))
2202	{
2203	my $struct = $source->AddFault()->AddValue()->AddStruct();
2204	$struct->AddMember(name=>"faultCode")->AddValue(i4=>$args{faultcode});
2205	$struct->AddMember(name=>"faultString")->AddValue(string=>$args{faultstring});
2206	}
2207	elsif (exists($args{params}))
2208	{
2209	my $params = $source->AddParams();
2210	foreach my $param (@{$args{params}})
2211	{
2212	$self->RPCEncode_Value($params->AddParam(),$param);
2213	}
2214	}
2215
2216	return $query;
2217	}
2218
2219
2220	###############################################################################
2221	#
2222	# RPCEncode_Value - Run through the value, and encode it into XML.
2223	#
2224	###############################################################################
2225	sub RPCEncode_Value
2226	{
2227	my $self = shift;
2228	my $obj = shift;
2229	my $value = shift;
2230
2231	if (ref($value) eq "ARRAY")
2232	{
2233	my $array = $obj->AddValue()->AddArray();
2234	foreach my $data (@{$value})
2235	{
2236	$self->RPCEncode_Value($array->AddData(),$data);
2237	}
2238	}
2239	elsif (ref($value) eq "HASH")
2240	{
2241	my $struct = $obj->AddValue()->AddStruct();
2242	foreach my $key (keys(%{$value}))
2243	{
2244	$self->RPCEncode_Value($struct->AddMember(name=>$key),$value->{$key});
2245	}
2246	}
2247	else
2248	{
2249	if ($value =~ /^(int\|i4\|boolean\|string\|double\|datetime\|base64):/i)
2250	{
2251	my $type = $1;
2252	my($val) = ($value =~ /^$type:(.*)$/);
2253	$obj->AddValue($type=>$val);
2254	}
2255	elsif ($value =~ /^[+-]?\d+$/)
2256	{
2257	$obj->AddValue(i4=>$value);
2258	}
2259	elsif ($value =~ /^(-?(?:\d+(?:\.\d)?\|\.\d+)\|([+-]?)(?=\d\|\.\d)\d(\.\d*)?([Ee]([+-]?\d+))?)$/)
2260	{
2261	$obj->AddValue(double=>$value);
2262	}
2263	else
2264	{
2265	$obj->AddValue(string=>$value);
2266	}
2267	}
2268	}
2269
2270
2271	###############################################################################
2272	#
2273	# RPCParse - Returns an array of the params sent in the RPC packet.
2274	#
2275	###############################################################################
2276	sub RPCParse
2277	{
2278	my $self = shift;
2279	my($iq) = @_;
2280
2281	my $query = $iq->GetQuery();
2282
2283	my $source;
2284	$source = $query->GetMethodCall() if $query->DefinedMethodCall();
2285	$source = $query->GetMethodResponse() if $query->DefinedMethodResponse();
2286
2287	if (defined($source))
2288	{
2289	if (($source->GetTag() eq "methodResponse") && ($source->DefinedFault()))
2290	{
2291	my %response =
2292	$self->RPCParse_Struct($source->GetFault()->GetValue()->GetStruct());
2293	return ("fault",\%response);
2294	}
2295
2296	if ($source->DefinedParams())
2297	{
2298	#------------------------------------------------------------------
2299	# The <param/>s part
2300	#------------------------------------------------------------------
2301	my @response;
2302	foreach my $param ($source->GetParams()->GetParams())
2303	{
2304	push(@response,$self->RPCParse_Value($param->GetValue()));
2305	}
2306	return ("ok",\@response);
2307	}
2308	}
2309	else
2310	{
2311	print "AAAAHHHH!!!!\n";
2312	}
2313	}
2314
2315
2316	###############################################################################
2317	#
2318	# RPCParse_Value - Takes a <value/> and returns the data it represents
2319	#
2320	###############################################################################
2321	sub RPCParse_Value
2322	{
2323	my $self = shift;
2324	my($value) = @_;
2325
2326	if ($value->DefinedStruct())
2327	{
2328	my %struct = $self->RPCParse_Struct($value->GetStruct());
2329	return \%struct;
2330	}
2331
2332	if ($value->DefinedArray())
2333	{
2334	my @array = $self->RPCParse_Array($value->GetArray());
2335	return \@array;
2336	}
2337
2338	return $value->GetI4() if $value->DefinedI4();
2339	return $value->GetInt() if $value->DefinedInt();
2340	return $value->GetBoolean() if $value->DefinedBoolean();
2341	return $value->GetString() if $value->DefinedString();
2342	return $value->GetDouble() if $value->DefinedDouble();
2343	return $value->GetDateTime() if $value->DefinedDateTime();
2344	return $value->GetBase64() if $value->DefinedBase64();
2345
2346	return $value->GetValue();
2347	}
2348
2349
2350	###############################################################################
2351	#
2352	# RPCParse_Struct - Takes a <struct/> and returns the hash of values.
2353	#
2354	###############################################################################
2355	sub RPCParse_Struct
2356	{
2357	my $self = shift;
2358	my($struct) = @_;
2359
2360	my %struct;
2361	foreach my $member ($struct->GetMembers())
2362	{
2363	$struct{$member->GetName()} = $self->RPCParse_Value($member->GetValue());
2364	}
2365
2366	return %struct;
2367	}
2368
2369
2370	###############################################################################
2371	#
2372	# RPCParse_Array - Takes a <array/> and returns the hash of values.
2373	#
2374	###############################################################################
2375	sub RPCParse_Array
2376	{
2377	my $self = shift;
2378	my($array) = @_;
2379
2380	my @array;
2381	foreach my $data ($array->GetDatas())
2382	{
2383	push(@array,$self->RPCParse_Value($data->GetValue()));
2384	}
2385
2386	return @array;
2387	}
2388
2389
2390	###############################################################################
2391	#
2392	# SearchRequest - This is a self contained function to send an iq tag
2393	# an id that requests the target address to send back
2394	# the required fields. It waits for a reply what the
2395	# same id to come back and tell the caller what the
2396	# fields are.
2397	#
2398	###############################################################################
2399	sub SearchRequest
2400	{
2401	my $self = shift;
2402	my %args;
2403	$args{mode} = "block";
2404	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2405
2406	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
2407
2408	#--------------------------------------------------------------------------
2409	# Create a Net::Jabber::IQ object to send to the server
2410	#--------------------------------------------------------------------------
2411	my $iq = $self->_iq();
2412	$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
2413	$iq->SetIQ(type=>"get");
2414	my $query = $iq->NewQuery("jabber:iq:search");
2415
2416	$self->{DEBUG}->Log1("SearchRequest: sent(",$iq->GetXML(),")");
2417
2418	#--------------------------------------------------------------------------
2419	# Send the IQ with the next available ID and wait for a reply with that
2420	# id to be received. Then grab the IQ reply.
2421	#--------------------------------------------------------------------------
2422	if ($args{mode} eq "passthru")
2423	{
2424	my $id = $self->UniqueID();
2425	$iq->SetIQ(id=>$id);
2426	$self->Send($iq);
2427	return $id;
2428	}
2429
2430	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
2431
2432	$iq = $self->SendAndReceiveWithID($iq,$timeout);
2433
2434	$self->{DEBUG}->Log1("SearchRequest: received(",$iq->GetXML(),")")
2435	if defined($iq);
2436
2437	#--------------------------------------------------------------------------
2438	# Check if there was an error.
2439	#--------------------------------------------------------------------------
2440	return unless defined($iq);
2441	if ($iq->GetType() eq "error")
2442	{
2443	$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
2444	$self->{DEBUG}->Log1("SearchRequest: error(",$self->GetErrorCode(),")");
2445	return;
2446	}
2447
2448	my %search;
2449	#--------------------------------------------------------------------------
2450	# From the reply IQ determine what fields are required and send a hash
2451	# back with the fields and any values that are already defined (like key)
2452	#--------------------------------------------------------------------------
2453	$query = $iq->GetQuery();
2454	$search{fields} = { $query->GetSearch() };
2455
2456	#--------------------------------------------------------------------------
2457	# Get any forms so that we have the option of showing a nive dynamic form
2458	# to the user and not just a bunch of fields.
2459	#--------------------------------------------------------------------------
2460	&ExtractForms(\%search,$query->GetX("jabber:x:data"));
2461
2462	#--------------------------------------------------------------------------
2463	# Get any oobs so that we have the option of sending the user to the http
2464	# form and not a dynamic one.
2465	#--------------------------------------------------------------------------
2466	&ExtractOobs(\%search,$query->GetX("jabber:x:oob"));
2467
2468	return %search;
2469	}
2470
2471
2472	###############################################################################
2473	#
2474	# SearchSend - This is a self contained function to send a search
2475	# iq tag with an id. Then wait for a reply what the same
2476	# id to come back and tell the caller what the result was.
2477	#
2478	###############################################################################
2479	sub SearchSend
2480	{
2481	my $self = shift;
2482	my %args;
2483	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2484
2485	#--------------------------------------------------------------------------
2486	# Create a Net::Jabber::IQ object to send to the server
2487	#--------------------------------------------------------------------------
2488	my $iq = $self->_iq();
2489	$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
2490	$iq->SetIQ(type=>"set");
2491	my $iqSearch = $iq->NewQuery("jabber:iq:search");
2492	$iqSearch->SetSearch(%args);
2493
2494	#--------------------------------------------------------------------------
2495	# Send the IQ.
2496	#--------------------------------------------------------------------------
2497	$self->Send($iq);
2498	}
2499
2500
2501	###############################################################################
2502	#
2503	# SearchSendData - This is a self contained function to send a search iq tag
2504	# with an id. It uses the jabber:x:data method to return the
2505	# data.
2506	#
2507	###############################################################################
2508	sub SearchSendData
2509	{
2510	my $self = shift;
2511	my $to = shift;
2512	my %args;
2513	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2514
2515	#--------------------------------------------------------------------------
2516	# Create a Net::Jabber::IQ object to send to the server
2517	#--------------------------------------------------------------------------
2518	my $iq = $self->_iq();
2519	$iq->SetIQ(to=>$to) if (defined($to) && ($to ne ""));
2520	$iq->SetIQ(type=>"set");
2521	my $iqSearch = $iq->NewQuery("jabber:iq:search");
2522	my $xForm = $iqSearch->NewX("jabber:x:data");
2523	foreach my $var (keys(%args))
2524	{
2525	next if ($args{$var} eq "");
2526	$xForm->AddField(var=>$var,
2527	value=>$args{$var}
2528	);
2529	}
2530
2531	#--------------------------------------------------------------------------
2532	# Send the IQ.
2533	#--------------------------------------------------------------------------
2534	$self->Send($iq);
2535	}
2536
2537
2538	###############################################################################
2539	#
2540	# TimeQuery - Sends an iq:time query to either the server or the specified
2541	# JID.
2542	#
2543	###############################################################################
2544	sub TimeQuery
2545	{
2546	my $self = shift;
2547	my %args;
2548	$args{mode} = "passthru";
2549	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2550
2551	$args{waitforid} = 0 unless exists($args{waitforid});
2552	my $waitforid = delete($args{waitforid});
2553	$args{mode} = "block" if $waitforid;
2554
2555	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
2556
2557	my $iq = $self->_iq();
2558	$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
2559	$iq->SetIQ(type=>'get',%args);
2560	my $time = $iq->NewQuery("jabber:iq:time");
2561
2562	if ($args{mode} eq "passthru")
2563	{
2564	my $id = $self->UniqueID();
2565	$iq->SetIQ(id=>$id);
2566	$self->Send($iq);
2567	return $id;
2568	}
2569
2570	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
2571
2572	$iq = $self->SendAndReceiveWithID($iq,$timeout);
2573
2574	return unless defined($iq);
2575
2576	my $query = $iq->GetQuery();
2577
2578	return unless defined($query);
2579
2580	my %result;
2581	$result{utc} = $query->GetUTC();
2582	$result{display} = $query->GetDisplay();
2583	$result{tz} = $query->GetTZ();
2584	return %result;
2585	}
2586
2587
2588	###############################################################################
2589	#
2590	# TimeSend - sends an iq:time packet to the specified user.
2591	#
2592	###############################################################################
2593	sub TimeSend
2594	{
2595	my $self = shift;
2596	my %args;
2597	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2598
2599	my $iq = $self->_iq();
2600	$iq->SetIQ(to=>delete($args{to}),
2601	type=>'result');
2602	my $time = $iq->NewQuery("jabber:iq:time");
2603	$time->SetTime(%args);
2604
2605	$self->Send($iq);
2606	}
2607
2608
2609
2610	###############################################################################
2611	#
2612	# VersionQuery - Sends an iq:version query to either the server or the
2613	# specified JID.
2614	#
2615	###############################################################################
2616	sub VersionQuery
2617	{
2618	my $self = shift;
2619	my %args;
2620	$args{mode} = "passthru";
2621	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2622
2623	$args{waitforid} = 0 unless exists($args{waitforid});
2624	my $waitforid = delete($args{waitforid});
2625	$args{mode} = "block" if $waitforid;
2626
2627	my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
2628
2629	my $iq = $self->_iq();
2630	$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
2631	$iq->SetIQ(type=>'get',%args);
2632	my $version = $iq->NewQuery("jabber:iq:version");
2633
2634	if ($args{mode} eq "passthru")
2635	{
2636	my $id = $self->UniqueID();
2637	$iq->SetIQ(id=>$id);
2638	$self->Send($iq);
2639	return $id;
2640	}
2641
2642	return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
2643
2644	$iq = $self->SendAndReceiveWithID($iq,$timeout);
2645
2646	return unless defined($iq);
2647
2648	my $query = $iq->GetQuery();
2649
2650	return unless defined($query);
2651
2652	my %result;
2653	$result{name} = $query->GetName();
2654	$result{ver} = $query->GetVer();
2655	$result{os} = $query->GetOS();
2656	return %result;
2657	}
2658
2659
2660	###############################################################################
2661	#
2662	# VersionSend - sends an iq:version packet to the specified user.
2663	#
2664	###############################################################################
2665	sub VersionSend
2666	{
2667	my $self = shift;
2668	my %args;
2669	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2670
2671	my $iq = $self->_iq();
2672	$iq->SetIQ(to=>delete($args{to}),
2673	type=>'result');
2674	my $version = $iq->NewQuery("jabber:iq:version");
2675	$version->SetVersion(%args);
2676
2677	$self->Send($iq);
2678	}
2679
2680
2681	###############################################################################
2682	#
2683	# MUCJoin - join a MUC room
2684	#
2685	###############################################################################
2686	sub MUCJoin
2687	{
2688	my $self = shift;
2689	my %args;
2690	while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
2691
2692	my $presence = $self->_presence();
2693	$presence->SetTo($args{room}.'@'.$args{server}.'/'.$args{nick});
2694	my $x = $presence->NewChild("http://jabber.org/protocol/muc");
2695
2696	if (exists($args{password}) && ($args{password} ne ""))
2697	{
2698	$x->SetMUC(password=>$args{password});
2699	}
2700
2701	return $presence->GetXML() if exists($args{'__netjabber__:test'});
2702	$self->Send($presence);
2703	}
2704
2705
2706	###############################################################################
2707	#+-----------------------------------------------------------------------------
2708	#\|
2709	#\| Helper Functions
2710	#\|
2711	#+-----------------------------------------------------------------------------
2712	###############################################################################
2713
2714
2715	###############################################################################
2716	#
2717	# ExtractForms - Helper function to make extracting jabber:x:data for forms
2718	# more centrally definable.
2719	#
2720	###############################################################################
2721	sub ExtractForms
2722	{
2723	my ($target,@xForms) = @_;
2724
2725	my $tempVar = "1";
2726	foreach my $xForm (@xForms) {
2727	$target->{instructions} = $xForm->GetInstructions();
2728	my $order = 0;
2729	foreach my $field ($xForm->GetFields())
2730	{
2731	$target->{form}->[$order]->{type} = $field->GetType()
2732	if $field->DefinedType();
2733	$target->{form}->[$order]->{label} = $field->GetLabel()
2734	if $field->DefinedLabel();
2735	$target->{form}->[$order]->{desc} = $field->GetDesc()
2736	if $field->DefinedDesc();
2737	$target->{form}->[$order]->{var} = $field->GetVar()
2738	if $field->DefinedVar();
2739	$target->{form}->[$order]->{var} = "__netjabber__:tempvar:".$tempVar++
2740	if !$field->DefinedVar();
2741	if ($field->DefinedValue())
2742	{
2743	if ($field->GetType() eq "list-multi")
2744	{
2745	$target->{form}->[$order]->{value} = [ $field->GetValue() ];
2746	}
2747	else
2748	{
2749	$target->{form}->[$order]->{value} = ($field->GetValue())[0];
2750	}
2751	}
2752	my $count = 0;
2753	foreach my $option ($field->GetOptions())
2754	{
2755	$target->{form}->[$order]->{options}->[$count]->{value} =
2756	$option->GetValue();
2757	$target->{form}->[$order]->{options}->[$count]->{label} =
2758	$option->GetLabel();
2759	$count++;
2760	}
2761	$order++;
2762	}
2763	foreach my $reported ($xForm->GetReported())
2764	{
2765	my $order = 0;
2766	foreach my $field ($reported->GetFields())
2767	{
2768	$target->{reported}->[$order]->{label} = $field->GetLabel();
2769	$target->{reported}->[$order]->{var} = $field->GetVar();
2770	$order++;
2771	}
2772	}
2773	}
2774	}
2775
2776
2777	###############################################################################
2778	#
2779	# ExtractOobs - Helper function to make extracting jabber:x:oob for forms
2780	# more centrally definable.
2781	#
2782	###############################################################################
2783	sub ExtractOobs
2784	{
2785	my ($target,@xOobs) = @_;
2786
2787	foreach my $xOob (@xOobs)
2788	{
2789	$target->{oob}->{url} = $xOob->GetURL();
2790	$target->{oob}->{desc} = $xOob->GetDesc();
2791	}
2792	}
2793
2794
2795	###############################################################################
2796	#+-----------------------------------------------------------------------------
2797	#\|
2798	#\| Default CallBacks
2799	#\|
2800	#+-----------------------------------------------------------------------------
2801	###############################################################################
2802
2803
2804	###############################################################################
2805	#
2806	# callbackInit - initialize the default callbacks
2807	#
2808	###############################################################################
2809	sub callbackInit
2810	{
2811	my $self = shift;
2812
2813	$self->SUPER::callbackInit();
2814
2815	$self->SetIQCallBacks("jabber:iq:last"=>
2816	{
2817	get=>sub{ $self->callbackGetIQLast(@_) },
2818	result=>sub{ $self->callbackResultIQLast(@_) }
2819	},
2820	"jabber:iq:rpc"=>
2821	{
2822	set=>sub{ $self->callbackSetIQRPC(@_) },
2823	},
2824	"jabber:iq:time"=>
2825	{
2826	get=>sub{ $self->callbackGetIQTime(@_) },
2827	result=>sub{ $self->callbackResultIQTime(@_) }
2828	},
2829	"jabber:iq:version"=>
2830	{
2831	get=>sub{ $self->callbackGetIQVersion(@_) },
2832	result=>sub{ $self->callbackResultIQVersion(@_) }
2833	},
2834	);
2835	}
2836
2837
2838	###############################################################################
2839	#
2840	# callbackSetIQRPC - callback to handle auto-replying to an iq:rpc by calling
2841	# the user registered functions.
2842	#
2843	###############################################################################
2844	sub callbackSetIQRPC
2845	{
2846	my $self = shift;
2847	my $sid = shift;
2848	my $iq = shift;
2849
2850	my $query = $iq->GetQuery();
2851
2852	my $reply = $iq->Reply(type=>"result");
2853	my $replyQuery = $reply->GetQuery();
2854
2855	if (!$query->DefinedMethodCall())
2856	{
2857	my $methodResponse = $replyQuery->AddMethodResponse();
2858	my $struct = $methodResponse->AddFault()->AddValue()->AddStruct();
2859	$struct->AddMember(name=>"faultCode")->AddValue(int=>400);
2860	$struct->AddMember(name=>"faultString")->AddValue(string=>"Missing methodCall.");
2861	$self->Send($reply,1);
2862	return;
2863	}
2864
2865	if (!$query->GetMethodCall()->DefinedMethodName())
2866	{
2867	my $methodResponse = $replyQuery->AddMethodResponse();
2868	my $struct = $methodResponse->AddFault()->AddValue()->AddStruct();
2869	$struct->AddMember(name=>"faultCode")->AddValue(int=>400);
2870	$struct->AddMember(name=>"faultString")->AddValue(string=>"Missing methodName.");
2871	$self->Send($reply,1);
2872	return;
2873	}
2874
2875	my $methodName = $query->GetMethodCall()->GetMethodName();
2876
2877	if (!exists($self->{RPCCB}->{$methodName}))
2878	{
2879	my $methodResponse = $replyQuery->AddMethodResponse();
2880	my $struct = $methodResponse->AddFault()->AddValue()->AddStruct();
2881	$struct->AddMember(name=>"faultCode")->AddValue(int=>404);
2882	$struct->AddMember(name=>"faultString")->AddValue(string=>"methodName $methodName not defined.");
2883	$self->Send($reply,1);
2884	return;
2885	}
2886
2887	my @params = $self->RPCParse($iq);
2888
2889	my @return = &{$self->{RPCCB}->{$methodName}}($iq,$params[1]);
2890
2891	if ($return[0] ne "ok") {
2892	my $methodResponse = $replyQuery->AddMethodResponse();
2893	my $struct = $methodResponse->AddFault()->AddValue()->AddStruct();
2894	$struct->AddMember(name=>"faultCode")->AddValue(int=>$return[1]->{faultCode});
2895	$struct->AddMember(name=>"faultString")->AddValue(string=>$return[1]->{faultString});
2896	$self->Send($reply,1);
2897	return;
2898	}
2899	$reply->RemoveQuery();
2900	$reply->AddQuery($self->RPCEncode(type=>"methodResponse",
2901	params=>$return[1]));
2902
2903	$self->Send($reply,1);
2904	}
2905
2906
2907	###############################################################################
2908	#
2909	# callbackGetIQTime - callback to handle auto-replying to an iq:time get.
2910	#
2911	###############################################################################
2912	sub callbackGetIQTime
2913	{
2914	my $self = shift;
2915	my $sid = shift;
2916	my $iq = shift;
2917
2918	my $query = $iq->GetQuery();
2919
2920	my $reply = $iq->Reply(type=>"result");
2921	my $replyQuery = $reply->GetQuery();
2922	$replyQuery->SetTime();
2923
2924	$self->Send($reply,1);
2925	}
2926
2927
2928	###############################################################################
2929	#
2930	# callbackResultIQTime - callback to handle formatting iq:time result into
2931	# a message.
2932	#
2933	###############################################################################
2934	sub callbackResultIQTime
2935	{
2936	my $self = shift;
2937	my $sid = shift;
2938	my $iq = shift;
2939
2940	my $fromJID = $iq->GetFrom("jid");
2941	my $query = $iq->GetQuery();
2942
2943	my $body = "UTC: ".$query->GetUTC()."\n";
2944	$body .= "Time: ".$query->GetDisplay()."\n";
2945	$body .= "Timezone: ".$query->GetTZ()."\n";
2946
2947	my $message = $self->_message();
2948	$message->SetMessage(to=>$iq->GetTo(),
2949	from=>$iq->GetFrom(),
2950	subject=>"CTCP: Time",
2951	body=>$body);
2952
2953
2954	$self->CallBack($sid,$message);
2955	}
2956
2957
2958	###############################################################################
2959	#
2960	# callbackGetIQVersion - callback to handle auto-replying to an iq:time
2961	# get.
2962	#
2963	###############################################################################
2964	sub callbackGetIQVersion
2965	{
2966	my $self = shift;
2967	my $sid = shift;
2968	my $iq = shift;
2969
2970	my $query = $iq->GetQuery();
2971
2972	my $reply = $iq->Reply(type=>"result");
2973	my $replyQuery = $reply->GetQuery();
2974	$replyQuery->SetVersion(name=>$self->{INFO}->{name},
2975	ver=>$self->{INFO}->{version},
2976	os=>"");
2977
2978	$self->Send($reply,1);
2979	}
2980
2981
2982	###############################################################################
2983	#
2984	# callbackResultIQVersion - callback to handle formatting iq:time result
2985	# into a message.
2986	#
2987	###############################################################################
2988	sub callbackResultIQVersion
2989	{
2990	my $self = shift;
2991	my $sid = shift;
2992	my $iq = shift;
2993
2994	my $query = $iq->GetQuery();
2995
2996	my $body = "Program: ".$query->GetName()."\n";
2997	$body .= "Version: ".$query->GetVer()."\n";
2998	$body .= "OS: ".$query->GetOS()."\n";
2999
3000	my $message = $self->_message();
3001	$message->SetMessage(to=>$iq->GetTo(),
3002	from=>$iq->GetFrom(),
3003	subject=>"CTCP: Version",
3004	body=>$body);
3005
3006	$self->CallBack($sid,$message);
3007	}
3008
3009
3010	###############################################################################
3011	#
3012	# callbackGetIQLast - callback to handle auto-replying to an iq:last get.
3013	#
3014	###############################################################################
3015	sub callbackGetIQLast
3016	{
3017	my $self = shift;
3018	my $sid = shift;
3019	my $iq = shift;
3020
3021	my $query = $iq->GetQuery();
3022	my $reply = $iq->Reply(type=>"result");
3023	my $replyQuery = $reply->GetQuery();
3024	$replyQuery->SetLast(seconds=>$self->LastActivity());
3025
3026	$self->Send($reply,1);
3027	}
3028
3029
3030	###############################################################################
3031	#
3032	# callbackResultIQLast - callback to handle formatting iq:last result into
3033	# a message.
3034	#
3035	###############################################################################
3036	sub callbackResultIQLast
3037	{
3038	my $self = shift;
3039	my $sid = shift;
3040	my $iq = shift;
3041
3042	my $fromJID = $iq->GetFrom("jid");
3043	my $query = $iq->GetQuery();
3044	my $seconds = $query->GetSeconds();
3045
3046	my $lastTime = &Net::Jabber::GetTimeStamp("local",(time - $seconds),"long");
3047
3048	my $elapsedTime = &Net::Jabber::GetHumanTime($seconds);
3049
3050	my $body;
3051	if ($fromJID->GetUserID() eq "")
3052	{
3053	$body = "Start Time: $lastTime\n";
3054	$body .= "Up time: $elapsedTime\n";
3055	$body .= "Message: ".$query->GetMessage()."\n"
3056	if ($query->DefinedMessage());
3057	}
3058	elsif ($fromJID->GetResource() eq "")
3059	{
3060	$body = "Logout Time: $lastTime\n";
3061	$body .= "Elapsed time: $elapsedTime\n";
3062	$body .= "Message: ".$query->GetMessage()."\n"
3063	if ($query->DefinedMessage());
3064	}
3065	else
3066	{
3067	$body = "Last activity: $lastTime\n";
3068	$body .= "Elapsed time: $elapsedTime\n";
3069	$body .= "Message: ".$query->GetMessage()."\n"
3070	if ($query->DefinedMessage());
3071	}
3072
3073	my $message = $self->_message();
3074	$message->SetMessage(from=>$iq->GetFrom(),
3075	subject=>"Last Activity",
3076	body=>$body);
3077
3078	$self->CallBack($sid,$message);
3079	}
3080
3081
3082	1;

Note: See TracBrowser for help on using the repository browser.

Download in other formats: