line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
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::XMPP3::Presence; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 NAME |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Net::XMPP3::Presence - XMPP Presence Module |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 SYNOPSIS |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
Net::XMPP3::Presence is a companion to the Net::XMPP3 module. |
31
|
|
|
|
|
|
|
It provides the user a simple interface to set and retrieve all |
32
|
|
|
|
|
|
|
parts of an XMPP Presence. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 DESCRIPTION |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
A Net::XMPP3::Presence object is passed to the callback function for |
37
|
|
|
|
|
|
|
the message. Also, the first argument to the callback functions is |
38
|
|
|
|
|
|
|
the session ID from XML::Streams. There are some cases where you |
39
|
|
|
|
|
|
|
might want this information, like if you created a Client that |
40
|
|
|
|
|
|
|
connects to two servers at once, or for writing a mini server. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
use Net::XMPP3; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub presence { |
45
|
|
|
|
|
|
|
my ($sid,$Pres) = @_; |
46
|
|
|
|
|
|
|
. |
47
|
|
|
|
|
|
|
. |
48
|
|
|
|
|
|
|
. |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
You now have access to all of the retrieval functions available. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
To create a new presence to send to the server: |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
use Net::XMPP3; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
$Pres = new Net::XMPP3::Presence(); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
Now you can call the creation functions below to populate the tag |
60
|
|
|
|
|
|
|
before sending it. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 METHODS |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head2 Retrieval functions |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
GetTo() - returns the value in the to='' attribute for the |
67
|
|
|
|
|
|
|
GetTo("jid") . If you specify "jid" as an argument |
68
|
|
|
|
|
|
|
then a Net::XMPP3::JID object is returned and |
69
|
|
|
|
|
|
|
you can easily parse the parts of the JID. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
$to = $Pres->GetTo(); |
72
|
|
|
|
|
|
|
$toJID = $Pres->GetTo("jid"); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
GetFrom() - returns the value in the from='' attribute for the |
75
|
|
|
|
|
|
|
GetFrom("jid") . If you specify "jid" as an argument |
76
|
|
|
|
|
|
|
then a Net::XMPP3::JID object is returned and |
77
|
|
|
|
|
|
|
you can easily parse the parts of the JID. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$from = $Pres->GetFrom(); |
80
|
|
|
|
|
|
|
$fromJID = $Pres->GetFrom("jid"); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
GetType() - returns the type='' attribute of the . Each |
83
|
|
|
|
|
|
|
presence is one of seven types: |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
available available to receive messages; default |
86
|
|
|
|
|
|
|
unavailable unavailable to receive anything |
87
|
|
|
|
|
|
|
subscribe ask the recipient to subscribe you |
88
|
|
|
|
|
|
|
subscribed tell the sender they are subscribed |
89
|
|
|
|
|
|
|
unsubscribe ask the recipient to unsubscribe you |
90
|
|
|
|
|
|
|
unsubscribed tell the sender they are unsubscribed |
91
|
|
|
|
|
|
|
probe probe |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$type = $Pres->GetType(); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
GetStatus() - returns a string with the current status of the resource. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
$status = $Pres->GetStatus(); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
GetPriority() - returns an integer with the priority of the resource |
100
|
|
|
|
|
|
|
The default is 0 if there is no priority in this |
101
|
|
|
|
|
|
|
presence. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
$priority = $Pres->GetPriority(); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
GetShow() - returns a string with the state the client should show. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
$show = $Pres->GetShow(); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 Creation functions |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
SetPresence(to=>string|JID - set multiple fields in the |
112
|
|
|
|
|
|
|
from=>string|JID, at one time. This is a cumulative |
113
|
|
|
|
|
|
|
type=>string, and over writing action. If you set |
114
|
|
|
|
|
|
|
status=>string, the "to" attribute twice, the second |
115
|
|
|
|
|
|
|
priority=>integer, setting is what is used. If you set |
116
|
|
|
|
|
|
|
meta=>string, the status, and then set the priority |
117
|
|
|
|
|
|
|
icon=>string, then both will be in the |
118
|
|
|
|
|
|
|
show=>string, tag. For valid settings read the |
119
|
|
|
|
|
|
|
loc=>string) specific Set functions below. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
$Pres->SetPresence(TYPE=>"away", |
122
|
|
|
|
|
|
|
StatuS=>"Out for lunch"); |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
SetTo(string) - sets the to attribute. You can either pass a string |
125
|
|
|
|
|
|
|
SetTo(JID) or a JID object. They must be valid JIDs or the |
126
|
|
|
|
|
|
|
server will return an error message. |
127
|
|
|
|
|
|
|
(ie. bob@jabber.org/Silent Bob, etc...) |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
$Pres->SetTo("bob\@jabber.org"); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
SetFrom(string) - sets the from='' attribute. You can either pass |
132
|
|
|
|
|
|
|
SetFrom(JID) a string or a JID object. They must be valid JIDs |
133
|
|
|
|
|
|
|
or the server will return an error message. (ie. |
134
|
|
|
|
|
|
|
jabber:bob@jabber.org/Work) This field is not |
135
|
|
|
|
|
|
|
required if you are writing a Client since the |
136
|
|
|
|
|
|
|
server will put the JID of your connection in there |
137
|
|
|
|
|
|
|
to prevent spamming. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
$Pres->SetFrom("jojo\@jabber.org"); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
SetType(string) - sets the type attribute. Valid settings are: |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
available available to receive messages; default |
144
|
|
|
|
|
|
|
unavailable unavailable to receive anything |
145
|
|
|
|
|
|
|
subscribe ask the recipient to subscribe you |
146
|
|
|
|
|
|
|
subscribed tell the sender they are subscribed |
147
|
|
|
|
|
|
|
unsubscribe ask the recipient to unsubscribe you |
148
|
|
|
|
|
|
|
unsubscribed tell the sender they are unsubscribed |
149
|
|
|
|
|
|
|
probe probe |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
$Pres->SetType("unavailable"); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
SetStatus(string) - sets the status tag to be whatever string the user |
154
|
|
|
|
|
|
|
wants associated with that resource. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
$Pres->SetStatus("Taking a nap"); |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
SetPriority(integer) - sets the priority of this resource. The highest |
159
|
|
|
|
|
|
|
resource attached to the xmpp account is the |
160
|
|
|
|
|
|
|
one that receives the messages. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
$Pres->SetPriority(10); |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
SetShow(string) - sets the name of the icon or string to display for |
165
|
|
|
|
|
|
|
this resource. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
$Pres->SetShow("away"); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Reply(hash) - creates a new Presence object and populates the to/from |
170
|
|
|
|
|
|
|
fields. If you specify a hash the same as with |
171
|
|
|
|
|
|
|
SetPresence then those values will override the Reply |
172
|
|
|
|
|
|
|
values. |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
$Reply = $Pres->Reply(); |
175
|
|
|
|
|
|
|
$Reply = $Pres->Reply(type=>"subscribed"); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head2 Removal functions |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
RemoveTo() - removes the to attribute from the . |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
$Pres->RemoveTo(); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
RemoveFrom() - removes the from attribute from the . |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
$Pres->RemoveFrom(); |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
RemoveType() - removes the type attribute from the . |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
$Pres->RemoveType(); |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
RemoveStatus() - removes the element from the . |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
$Pres->RemoveStatus(); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
RemovePriority() - removes the element from the |
196
|
|
|
|
|
|
|
. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
$Pres->RemovePriority(); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
RemoveShow() - removes the element from the . |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
$Pres->RemoveShow(); |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head2 Test functions |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
DefinedTo() - returns 1 if the to attribute is defined in the |
207
|
|
|
|
|
|
|
, 0 otherwise. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$test = $Pres->DefinedTo(); |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
DefinedFrom() - returns 1 if the from attribute is defined in the |
212
|
|
|
|
|
|
|
, 0 otherwise. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
$test = $Pres->DefinedFrom(); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
DefinedType() - returns 1 if the type attribute is defined in the |
217
|
|
|
|
|
|
|
, 0 otherwise. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
$test = $Pres->DefinedType(); |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
DefinedStatus() - returns 1 if is defined in the |
222
|
|
|
|
|
|
|
, 0 otherwise. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
$test = $Pres->DefinedStatus(); |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
DefinedPriority() - returns 1 if is defined in the |
227
|
|
|
|
|
|
|
, 0 otherwise. |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
$test = $Pres->DefinedPriority(); |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
DefinedShow() - returns 1 if is defined in the , |
232
|
|
|
|
|
|
|
0 otherwise. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
$test = $Pres->DefinedShow(); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head1 AUTHOR |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Ryan Eatmon |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head1 COPYRIGHT |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
This module is free software, you can redistribute it and/or modify it |
243
|
|
|
|
|
|
|
under the LGPL. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=cut |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
require 5.003; |
248
|
11
|
|
|
11
|
|
54
|
use strict; |
|
11
|
|
|
|
|
20
|
|
|
11
|
|
|
|
|
436
|
|
249
|
11
|
|
|
11
|
|
56
|
use Carp; |
|
11
|
|
|
|
|
23
|
|
|
11
|
|
|
|
|
642
|
|
250
|
11
|
|
|
11
|
|
55
|
use vars qw( %FUNCTIONS ); |
|
11
|
|
|
|
|
19
|
|
|
11
|
|
|
|
|
381
|
|
251
|
11
|
|
|
11
|
|
61
|
use Net::XMPP3::Stanza; |
|
11
|
|
|
|
|
30
|
|
|
11
|
|
|
|
|
261
|
|
252
|
11
|
|
|
11
|
|
53
|
use base qw( Net::XMPP3::Stanza ); |
|
11
|
|
|
|
|
422
|
|
|
11
|
|
|
|
|
5526
|
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub new |
255
|
|
|
|
|
|
|
{ |
256
|
3
|
|
|
3
|
0
|
17
|
my $proto = shift; |
257
|
3
|
|
33
|
|
|
18
|
my $class = ref($proto) || $proto; |
258
|
3
|
|
|
|
|
6
|
my $self = { }; |
259
|
|
|
|
|
|
|
|
260
|
3
|
|
|
|
|
12
|
bless($self, $proto); |
261
|
|
|
|
|
|
|
|
262
|
3
|
|
|
|
|
16
|
$self->{DEBUGHEADER} = "Presence"; |
263
|
3
|
|
|
|
|
8
|
$self->{TAG} = "presence"; |
264
|
|
|
|
|
|
|
|
265
|
3
|
|
|
|
|
7
|
$self->{FUNCS} = \%FUNCTIONS; |
266
|
|
|
|
|
|
|
|
267
|
3
|
|
|
|
|
18
|
$self->_init(@_); |
268
|
|
|
|
|
|
|
|
269
|
3
|
|
|
|
|
7
|
return $self; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
1
|
|
|
1
|
|
3
|
sub _presence { my $self = shift; return new Net::XMPP3::Presence(); } |
|
1
|
|
|
|
|
5
|
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
$FUNCTIONS{Error}->{path} = 'error/text()'; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
$FUNCTIONS{ErrorCode}->{path} = 'error/@code'; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
$FUNCTIONS{From}->{type} = 'jid'; |
280
|
|
|
|
|
|
|
$FUNCTIONS{From}->{path} = '@from'; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
$FUNCTIONS{ID}->{path} = '@id'; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
$FUNCTIONS{Priority}->{path} = 'priority/text()'; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
$FUNCTIONS{Show}->{path} = 'show/text()'; |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
$FUNCTIONS{Status}->{path} = 'status/text()'; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
$FUNCTIONS{To}->{type} = 'jid'; |
291
|
|
|
|
|
|
|
$FUNCTIONS{To}->{path} = '@to'; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
$FUNCTIONS{Type}->{path} = '@type'; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
$FUNCTIONS{XMLNS}->{path} = '@xmlns'; |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
$FUNCTIONS{Presence}->{type} = 'master'; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
$FUNCTIONS{Child}->{type} = 'child'; |
300
|
|
|
|
|
|
|
$FUNCTIONS{Child}->{path} = '*[@xmlns]'; |
301
|
|
|
|
|
|
|
$FUNCTIONS{Child}->{child} = {}; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
############################################################################## |
304
|
|
|
|
|
|
|
# |
305
|
|
|
|
|
|
|
# Reply - returns a Net::XMPP3::Presence object with the proper fields |
306
|
|
|
|
|
|
|
# already populated for you. |
307
|
|
|
|
|
|
|
# |
308
|
|
|
|
|
|
|
############################################################################## |
309
|
|
|
|
|
|
|
sub Reply |
310
|
|
|
|
|
|
|
{ |
311
|
1
|
|
|
1
|
0
|
2891
|
my $self = shift; |
312
|
1
|
|
|
|
|
2
|
my %args; |
313
|
1
|
|
|
|
|
8
|
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); } |
|
0
|
|
|
|
|
0
|
|
314
|
|
|
|
|
|
|
|
315
|
1
|
|
|
|
|
4
|
my $reply = $self->_presence(); |
316
|
|
|
|
|
|
|
|
317
|
1
|
50
|
|
|
|
9
|
$reply->SetID($self->GetID()) if ($self->GetID() ne ""); |
318
|
|
|
|
|
|
|
|
319
|
1
|
50
|
|
|
|
23
|
$reply->SetPresence((($self->GetFrom() ne "") ? |
|
|
50
|
|
|
|
|
|
320
|
|
|
|
|
|
|
(to=>$self->GetFrom()) : |
321
|
|
|
|
|
|
|
() |
322
|
|
|
|
|
|
|
), |
323
|
|
|
|
|
|
|
(($self->GetTo() ne "") ? |
324
|
|
|
|
|
|
|
(from=>$self->GetTo()) : |
325
|
|
|
|
|
|
|
() |
326
|
|
|
|
|
|
|
), |
327
|
|
|
|
|
|
|
); |
328
|
|
|
|
|
|
|
|
329
|
1
|
|
|
|
|
10
|
$reply->SetPresence(%args); |
330
|
|
|
|
|
|
|
|
331
|
1
|
|
|
|
|
6
|
return $reply; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
1; |