File Coverage

blib/lib/Net/XMPP/Presence.pm
Criterion Covered Total %
statement 36 37 97.3
branch 3 6 50.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 1 2 50.0
total 50 57 87.7


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::XMPP::Presence;
23              
24             =head1 NAME
25              
26             Net::XMPP::Presence - XMPP Presence Module
27              
28             =head1 SYNOPSIS
29              
30             Net::XMPP::Presence is a companion to the Net::XMPP 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::XMPP::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::XMPP;
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::XMPP;
56              
57             $Pres = Net::XMPP::Presence->new();
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             =over 4
67              
68             =item GetTo
69              
70             GetTo()
71              
72             returns the value in the to='' attribute for the .
73              
74             GetTo("jid")
75              
76              
77             If you specify "jid" as an argument
78             then a Net::XMPP::JID object is returned and
79             you can easily parse the parts of the JID.
80              
81             $to = $Pres->GetTo();
82             $toJID = $Pres->GetTo("jid");
83              
84             =item GetFrom
85              
86             GetFrom()
87              
88             returns the value in the from='' attribute for the .
89              
90             GetFrom("jid")
91              
92             If you specify "jid" as an argument
93             then a Net::XMPP::JID object is returned and
94             you can easily parse the parts of the JID.
95              
96             $from = $Pres->GetFrom();
97             $fromJID = $Pres->GetFrom("jid");
98              
99             =item GetType
100              
101             GetType()
102              
103             returns the type='' attribute of the . Each
104             presence is one of seven types:
105              
106             available available to receive messages; default
107             unavailable unavailable to receive anything
108             subscribe ask the recipient to subscribe you
109             subscribed tell the sender they are subscribed
110             unsubscribe ask the recipient to unsubscribe you
111             unsubscribed tell the sender they are unsubscribed
112             probe probe
113              
114             $type = $Pres->GetType();
115              
116             =item GetStatus
117              
118             GetStatus()
119              
120             returns a string with the current status of the resource.
121              
122             $status = $Pres->GetStatus();
123              
124             =item GetPriority
125              
126             GetPriority()
127              
128             returns an integer with the priority of the resource
129             The default is 0 if there is no priority in this
130             presence.
131              
132             $priority = $Pres->GetPriority();
133              
134             =item GetShow
135              
136             GetShow()
137              
138             Returns a string with the state the client should show.
139              
140             $show = $Pres->GetShow();
141              
142             =back
143              
144             =head2 Creation functions
145              
146             =over 4
147              
148             =item SetPresence
149              
150             SetPresence(to=>string|JID
151             from=>string|JID,
152             type=>string,
153             status=>string,
154             priority=>integer,
155             meta=>string,
156             icon=>string,
157             show=>string,
158             loc=>string)
159              
160             set multiple fields in the
161             at one time. This is a cumulative
162             and over writing action. If you set
163             the "to" attribute twice, the second
164             setting is what is used. If you set
165             the status, and then set the priority
166             then both will be in the
167             tag. For valid settings read the
168             specific Set functions below.
169              
170             $Pres->SetPresence(TYPE=>"away", StatuS=>"Out for lunch");
171              
172             =item SetTo
173              
174             SetTo(string)
175             SetTo(JID)
176              
177             sets the to attribute. You can either pass a string
178             or a JID object. They must be valid JIDs or the
179             server will return an error message.
180             (ie. bob@jabber.org/Silent Bob, etc...)
181              
182             $Pres->SetTo("bob\@jabber.org");
183              
184             =item SetFrom
185              
186             SetFrom(string)
187              
188             sets the from='' attribute. You can either pass
189              
190             SetFrom(JID)
191              
192             A string or a JID object. They must be valid JIDs
193             or the server will return an error message. (ie.
194             jabber:bob@jabber.org/Work) This field is not
195             required if you are writing a Client since the
196             server will put the JID of your connection in there
197             to prevent spamming.
198              
199             $Pres->SetFrom("jojo\@jabber.org");
200              
201             =item SetType
202              
203             SetType(string)
204              
205             sets the type attribute. Valid settings are:
206              
207             available available to receive messages; default
208             unavailable unavailable to receive anything
209             subscribe ask the recipient to subscribe you
210             subscribed tell the sender they are subscribed
211             unsubscribe ask the recipient to unsubscribe you
212             unsubscribed tell the sender they are unsubscribed
213             probe probe
214              
215             $Pres->SetType("unavailable");
216              
217             =item SetStatus
218              
219             SetStatus(string)
220              
221             sets the status tag to be whatever string the user
222             wants associated with that resource.
223              
224             $Pres->SetStatus("Taking a nap");
225              
226             =item SetPriority
227              
228             SetPriority(integer)
229              
230             sets the priority of this resource. The highest
231             resource attached to the xmpp account is the
232             one that receives the messages.
233              
234             $Pres->SetPriority(10);
235              
236             =item SetShow
237              
238             SetShow(string)
239              
240             Sets the name of the icon or string to display for this resource.
241              
242             $Pres->SetShow("away");
243              
244             =item Reply
245              
246             Reply(hash)
247              
248             creates a new Presence object and populates the to/from
249             fields. If you specify a hash the same as with
250             SetPresence then those values will override the Reply
251             values.
252              
253             $Reply = $Pres->Reply();
254             $Reply = $Pres->Reply(type=>"subscribed");
255              
256             =back
257              
258             =head2 Removal functions
259              
260             =over 4
261              
262             =item RemoveTo
263              
264             removes the to attribute from the .
265              
266             $Pres->RemoveTo();
267              
268             =item RemoveFrom
269              
270             removes the from attribute from the .
271              
272             $Pres->RemoveFrom();
273              
274             =item RemoveType
275              
276             removes the type attribute from the .
277              
278             $Pres->RemoveType();
279              
280             =item RemoveStatus
281              
282             removes the element from the .
283              
284             $Pres->RemoveStatus();
285              
286             =item RemovePriority
287              
288             removes the element from the .
289              
290             $Pres->RemovePriority();
291              
292             =item RemoveShow
293              
294             removes the element from the .
295              
296             $Pres->RemoveShow();
297              
298             =back
299              
300             =head2 Test functions
301              
302             =over 4
303              
304             =item DefinedTo
305              
306             returns 1 if the to attribute is defined in the , 0 otherwise.
307              
308             $test = $Pres->DefinedTo();
309              
310             =item DefinedFrom
311              
312             returns 1 if the from attribute is defined in the , 0 otherwise.
313              
314             $test = $Pres->DefinedFrom();
315              
316             =item DefinedType
317              
318             returns 1 if the type attribute is defined in the , 0 otherwise.
319              
320             $test = $Pres->DefinedType();
321              
322             =item DefinedStatus
323              
324             returns 1 if is defined in the , 0 otherwise.
325              
326             $test = $Pres->DefinedStatus();
327              
328             =item DefinedPriority
329              
330             returns 1 if is defined in the , 0 otherwise.
331              
332             $test = $Pres->DefinedPriority();
333              
334             =item DefinedShow
335              
336             returns 1 if is defined in the , 0 otherwise.
337              
338             $test = $Pres->DefinedShow();
339              
340             =back
341              
342             =head1 AUTHOR
343              
344             Originally authored by Ryan Eatmon.
345              
346             Previously maintained by Eric Hacker.
347              
348             Currently maintained by Darian Anthony Patrick.
349              
350             =head1 COPYRIGHT
351              
352             This module is free software, you can redistribute it and/or modify it
353             under the LGPL 2.1.
354              
355             =cut
356              
357             require 5.008;
358 15     15   86 use strict;
  15         21  
  15         535  
359 15     15   66 use warnings;
  15         19  
  15         365  
360              
361 15     15   58 use Carp;
  15         16  
  15         778  
362 15     15   65 use vars qw( %FUNCTIONS );
  15         22  
  15         552  
363 15     15   67 use Net::XMPP::Stanza;
  15         26  
  15         365  
364 15     15   61 use base qw( Net::XMPP::Stanza );
  15         19  
  15         6119  
365              
366             sub new
367             {
368 3     3 0 15 my $proto = shift;
369 3   33     20 my $class = ref($proto) || $proto;
370 3         6 my $self = { };
371              
372 3         12 bless($self, $proto);
373              
374 3         16 $self->{DEBUGHEADER} = "Presence";
375 3         7 $self->{TAG} = "presence";
376              
377 3         9 $self->{FUNCS} = \%FUNCTIONS;
378              
379 3         22 $self->_init(@_);
380              
381 3         7 return $self;
382             }
383              
384 1     1   4 sub _presence { return Net::XMPP::Presence->new(); }
385              
386              
387             $FUNCTIONS{Error}->{path} = 'error/text()';
388              
389             $FUNCTIONS{ErrorCode}->{path} = 'error/@code';
390              
391             $FUNCTIONS{From}->{type} = 'jid';
392             $FUNCTIONS{From}->{path} = '@from';
393              
394             $FUNCTIONS{ID}->{path} = '@id';
395              
396             $FUNCTIONS{Priority}->{path} = 'priority/text()';
397              
398             $FUNCTIONS{Show}->{path} = 'show/text()';
399              
400             $FUNCTIONS{Status}->{path} = 'status/text()';
401              
402             $FUNCTIONS{To}->{type} = 'jid';
403             $FUNCTIONS{To}->{path} = '@to';
404              
405             $FUNCTIONS{Type}->{path} = '@type';
406              
407             $FUNCTIONS{XMLNS}->{path} = '@xmlns';
408              
409             $FUNCTIONS{Presence}->{type} = 'master';
410              
411             $FUNCTIONS{Child}->{type} = 'child';
412             $FUNCTIONS{Child}->{path} = '*[@xmlns]';
413             $FUNCTIONS{Child}->{child} = {};
414              
415             ##############################################################################
416             #
417             # Reply - returns a Net::XMPP::Presence object with the proper fields
418             # already populated for you.
419             #
420             ##############################################################################
421             sub Reply
422             {
423 1     1 1 563 my $self = shift;
424 1         2 my %args;
425 1         21 while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
  0         0  
426              
427 1         4 my $reply = $self->_presence();
428              
429 1 50       6 $reply->SetID($self->GetID()) if ($self->GetID() ne "");
430              
431 1 50       21 $reply->SetPresence((($self->GetFrom() ne "") ?
    50          
432             (to=>$self->GetFrom()) :
433             ()
434             ),
435             (($self->GetTo() ne "") ?
436             (from=>$self->GetTo()) :
437             ()
438             ),
439             );
440              
441 1         7 $reply->SetPresence(%args);
442              
443 1         6 return $reply;
444             }
445              
446              
447             1;