File Coverage

blib/lib/Net/XMPP/Message.pm
Criterion Covered Total %
statement 44 61 72.1
branch 6 14 42.8
condition 2 6 33.3
subroutine 9 15 60.0
pod 0 8 0.0
total 61 104 58.6


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::Message;
23              
24             =head1 NAME
25              
26             Net::XMPP::Message - XMPP Message Module
27              
28             =head1 SYNOPSIS
29              
30             Net::XMPP::Message 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 Message.
33              
34             =head1 DESCRIPTION
35              
36             A Net::XMPP::Message 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::Stream. There are some cases where you
39             might want thisinformation, 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 message {
45             my ($sid,$Mess) = @_;
46             .
47             .
48             .
49             }
50              
51             You now have access to all of the retrieval functions available.
52              
53             To create a new message to send to the server:
54              
55             use Net::XMPP;
56              
57             $Mess = Net::XMPP::Message->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             GetTo() - returns the value in the to='' attribute for the
67             GetTo("jid") . If you specify "jid" as an argument
68             then a Net::XMPP::JID object is returned and
69             you can easily parse the parts of the JID.
70              
71             $to = $Mess->GetTo();
72             $toJID = $Mess->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::XMPP::JID object is returned and
77             you can easily parse the parts of the JID.
78              
79             $from = $Mess->GetFrom();
80             $fromJID = $Mess->GetFrom("jid");
81              
82             GetType() - returns the type='' attribute of the . Each
83             message is one of four types:
84              
85             normal regular message (default if type is blank)
86             chat one on one chat
87             groupchat multi-person chat
88             headline headline
89             error error message
90              
91             $type = $Mess->GetType();
92              
93             GetSubject() - returns the data in the tag.
94              
95             $subject = $Mess->GetSubject();
96              
97             GetBody() - returns the data in the tag.
98              
99             $body = $Mess->GetBody();
100              
101             GetThread() - returns the data in the tag.
102              
103             $thread = $Mess->GetThread();
104              
105             GetError() - returns a string with the data of the tag.
106              
107             $error = $Mess->GetError();
108              
109             GetErrorCode() - returns a string with the code='' attribute of the
110             tag.
111              
112             $errCode = $Mess->GetErrorCode();
113              
114             GetTimeStamp() - returns a string that represents the time this
115             message object was created (and probably received)
116             for sending to the client. If there is a
117             jabber:x:delay tag then that time is used to show
118             when the message was sent.
119              
120             $date = $Mess->GetTimeStamp();
121              
122              
123             =head2 Creation functions
124              
125             SetMessage(to=>string|JID, - set multiple fields in the
126             from=>string|JID, at one time. This is a cumulative
127             type=>string, and over writing action. If you set
128             subject=>string, the "to" attribute twice, the second
129             body=>string, setting is what is used. If you set
130             thread=>string, the subject, and then set the body
131             errorcode=>string, then both will be in the
132             error=>string) tag. For valid settings read the
133             specific Set functions below.
134              
135             $Mess->SetMessage(TO=>"bob\@jabber.org",
136             Subject=>"Lunch",
137             BoDy=>"Let's do lunch!");
138             $Mess->SetMessage(to=>"bob\@jabber.org",
139             from=>"jabber.org",
140             errorcode=>404,
141             error=>"Not found");
142              
143             SetTo(string) - sets the to='' attribute. You can either pass
144             SetTo(JID) a string or a JID object. They must be valid JIDs
145             or the server will return an error message.
146             (ie. bob@jabber.org/Work)
147              
148             $Mess->SetTo("test\@jabber.org");
149              
150             SetFrom(string) - sets the from='' attribute. You can either pass
151             SetFrom(JID) a string or a JID object. They must be valid JIDs
152             or the server will return an error message. (ie.
153             jabber:bob@jabber.org/Work) This field is not
154             required if you are writing a Client since the
155             server will put the JID of your connection in
156             there to prevent spamming.
157              
158             $Mess->SetFrom("me\@jabber.org");
159              
160             SetType(string) - sets the type attribute. Valid settings are:
161              
162             normal regular message (default if blank)
163             chat one one one chat style message
164             groupchat multi-person chatroom message
165             headline news headline, stock ticker, etc...
166             error error message
167              
168             $Mess->SetType("groupchat");
169              
170             SetSubject(string) - sets the subject of the .
171              
172             $Mess->SetSubject("This is a test");
173              
174             SetBody(string) - sets the body of the .
175              
176             $Mess->SetBody("To be or not to be...");
177              
178             SetThread(string) - sets the thread of the . You should
179             copy this out of the message being replied to so
180             that the thread is maintained.
181              
182             $Mess->SetThread("AE912B3");
183              
184             SetErrorCode(string) - sets the error code of the .
185              
186             $Mess->SetErrorCode(403);
187              
188             SetError(string) - sets the error string of the .
189              
190             $Mess->SetError("Permission Denied");
191              
192             Reply(hash) - creates a new Message object and populates the
193             to/from, and the subject by putting "re: " in
194             front. If you specify a hash the same as with
195             SetMessage then those values will override the
196             Reply values.
197              
198             $Reply = $Mess->Reply();
199             $Reply = $Mess->Reply(type=>"chat");
200              
201             =head2 Removal functions
202              
203             RemoveTo() - removes the to attribute from the .
204              
205             $Mess->RemoveTo();
206              
207             RemoveFrom() - removes the from attribute from the .
208              
209             $Mess->RemoveFrom();
210              
211             RemoveType() - removes the type attribute from the .
212              
213             $Mess->RemoveType();
214              
215             RemoveSubject() - removes the element from the
216             .
217              
218             $Mess->RemoveSubject();
219              
220             RemoveBody() - removes the element from the
221             .
222              
223             $Mess->RemoveBody();
224              
225             RemoveThread() - removes the element from the .
226              
227             $Mess->RemoveThread();
228              
229             RemoveError() - removes the element from the .
230              
231             $Mess->RemoveError();
232              
233             RemoveErrorCode() - removes the code attribute from the
234             element in the .
235              
236             $Mess->RemoveErrorCode();
237              
238             =head2 Test functions
239              
240             DefinedTo() - returns 1 if the to attribute is defined in the
241             , 0 otherwise.
242              
243             $test = $Mess->DefinedTo();
244              
245             DefinedFrom() - returns 1 if the from attribute is defined in the
246             , 0 otherwise.
247              
248             $test = $Mess->DefinedFrom();
249              
250             DefinedType() - returns 1 if the type attribute is defined in the
251             , 0 otherwise.
252              
253             $test = $Mess->DefinedType();
254              
255             DefinedSubject() - returns 1 if is defined in the
256             , 0 otherwise.
257              
258             $test = $Mess->DefinedSubject();
259              
260             DefinedBody() - returns 1 if is defined in the ,
261             0 otherwise.
262              
263             $test = $Mess->DefinedBody();
264              
265             DefinedThread() - returns 1 if is defined in the ,
266             0 otherwise.
267              
268             $test = $Mess->DefinedThread();
269              
270             DefinedErrorCode() - returns 1 if is defined in the
271             , 0 otherwise.
272              
273             $test = $Mess->DefinedErrorCode();
274              
275             DefinedError() - returns 1 if the code attribute is defined in the
276             , 0 otherwise.
277              
278             $test = $Mess->DefinedError();
279              
280             =head1 AUTHOR
281              
282             Originally authored by Ryan Eatmon.
283              
284             Previously maintained by Eric Hacker.
285              
286             Currently maintained by Darian Anthony Patrick.
287              
288             =head1 COPYRIGHT
289              
290             This module is free software, you can redistribute it and/or modify it
291             under the LGPL 2.1.
292              
293             =cut
294              
295             require 5.008;
296 15     15   63 use strict;
  15         20  
  15         591  
297 15     15   71 use warnings;
  15         18  
  15         365  
298 15     15   62 use Carp;
  15         16  
  15         882  
299 15     15   60 use vars qw( %FUNCTIONS );
  15         22  
  15         540  
300 15     15   64 use Net::XMPP::Stanza;
  15         25  
  15         266  
301 15     15   56 use base qw( Net::XMPP::Stanza );
  15         17  
  15         9200  
302              
303             sub new
304             {
305 4     4 0 1533 my $proto = shift;
306 4   33     24 my $class = ref($proto) || $proto;
307 4         8 my $self = {};
308              
309 4         10 bless($self, $proto);
310              
311 4         20 $self->{DEBUGHEADER} = "Message";
312 4         8 $self->{TAG} = "message";
313 4         20 $self->{TIMESTAMP} = &Net::XMPP::GetTimeStamp("local");
314              
315 4         12 $self->{FUNCS} = \%FUNCTIONS;
316              
317 4         31 $self->_init(@_);
318              
319 4         8 return $self;
320             }
321              
322 1     1   2 sub _message { my $self = shift; return Net::XMPP::Message->new(); }
  1         5  
323              
324             # Copied from Net::Jabber::Message because GetTimeStamp doesn't work without DefinedX
325 0     0 0 0 sub GetX { my $self = shift; $self->GetChild(@_); }
  0         0  
326 0     0 0 0 sub DefinedX { my $self = shift; $self->DefinedChild(@_); }
  0         0  
327 0     0 0 0 sub NewX { my $self = shift; $self->NewChild(@_); }
  0         0  
328 0     0 0 0 sub AddX { my $self = shift; $self->AddChild(@_); }
  0         0  
329 0     0 0 0 sub RemoveX { my $self = shift; $self->RemoveChild(@_); }
  0         0  
330              
331             $FUNCTIONS{Body}->{path} = 'body/text()';
332              
333             $FUNCTIONS{Error}->{path} = 'error/text()';
334              
335             $FUNCTIONS{ErrorCode}->{path} = 'error/@code';
336              
337             $FUNCTIONS{From}->{type} = 'jid';
338             $FUNCTIONS{From}->{path} = '@from';
339              
340             $FUNCTIONS{ID}->{path} = '@id';
341              
342             $FUNCTIONS{Subject}->{path} = 'subject/text()';
343              
344             $FUNCTIONS{Thread}->{path} = 'thread/text()';
345              
346             $FUNCTIONS{To}->{type} = 'jid';
347             $FUNCTIONS{To}->{path} = '@to';
348              
349             $FUNCTIONS{Type}->{path} = '@type';
350              
351             $FUNCTIONS{XMLNS}->{path} = '@xmlns';
352              
353             $FUNCTIONS{Message}->{type} = 'master';
354              
355             $FUNCTIONS{Child}->{type} = 'child';
356             $FUNCTIONS{Child}->{path} = '*[@xmlns]';
357             $FUNCTIONS{Child}->{child} = {};
358              
359             ##############################################################################
360             #
361             # GetTimeStamp - returns a string with the time stamp of when this object
362             # was created.
363             #
364             ##############################################################################
365             sub GetTimeStamp
366             {
367 0     0 0 0 my $self = shift;
368              
369 0 0       0 if ($self->DefinedX("jabber:x:delay"))
370             {
371 0         0 my @xTags = $self->GetX("jabber:x:delay");
372 0         0 my $xTag = $xTags[0];
373 0         0 $self->{TIMESTAMP} = &Net::XMPP::GetTimeStamp("utcdelaylocal",$xTag->GetStamp());
374             }
375              
376 0         0 return $self->{TIMESTAMP};
377             }
378              
379              
380             ##############################################################################
381             #
382             # Reply - returns a Net::XMPP::Message object with the proper fields
383             # already populated for you.
384             #
385             ##############################################################################
386             sub Reply
387             {
388 1     1 0 309 my $self = shift;
389 1         2 my %args;
390 1         5 while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
  0         0  
391              
392 1         3 my $reply = $self->_message();
393              
394 1 50 33     5 if (($self->GetType() eq "") || ($self->GetType() eq "normal"))
395             {
396 1         5 my $subject = $self->GetSubject();
397 1         4 $subject =~ s/re\:\s+//i;
398 1         6 $reply->SetSubject("re: $subject");
399             }
400 1 50       27 $reply->SetThread($self->GetThread()) if ($self->GetThread() ne "");
401 1 50       26 $reply->SetID($self->GetID()) if ($self->GetID() ne "");
402 1 50       17 $reply->SetType($self->GetType()) if ($self->GetType() ne "");
403 1 50       5 $reply->SetMessage((($self->GetFrom() ne "") ?
    50          
404             (to=>$self->GetFrom()) :
405             ()
406             ),
407             (($self->GetTo() ne "") ?
408             (from=>$self->GetTo()) :
409             ()
410             ),
411             );
412 1         7 $reply->SetMessage(%args);
413              
414 1         4 return $reply;
415             }
416              
417              
418             1;