source: perl/lib/Net/XMPP/Message.pm @ 3405394

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 3405394 was 0ff8d110, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 18 years ago
Adding XML::Stream, Net::XMPP, and Net::Jabber to perl/lib/
  • Property mode set to 100644
File size: 12.6 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
22package Net::XMPP::Message;
23
24=head1 NAME
25
26Net::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 = new Net::XMPP::Message();
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")   <message/>.  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")   <message/>.  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 <message/>.  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 <subject/> tag.
94
95                 $subject = $Mess->GetSubject();
96
97  GetBody() - returns the data in the <body/> tag.
98
99              $body = $Mess->GetBody();
100
101  GetThread() - returns the data in the <thread/> tag.
102
103                $thread = $Mess->GetThread();
104
105  GetError() - returns a string with the data of the <error/> tag.
106
107               $error = $Mess->GetError();
108
109  GetErrorCode() - returns a string with the code='' attribute of the
110                   <error/> 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 <message/>
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 <message/>
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 <message/>.
171
172                       $Mess->SetSubject("This is a test");
173
174  SetBody(string) - sets the body of the <message/>.
175
176                    $Mess->SetBody("To be or not to be...");
177
178  SetThread(string) - sets the thread of the <message/>.  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 <message/>.
185
186                         $Mess->SetErrorCode(403);
187
188  SetError(string) - sets the error string of the <message/>.
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 <message/>.
204
205               $Mess->RemoveTo();
206 
207  RemoveFrom() - removes the from attribute from the <message/>.
208
209                 $Mess->RemoveFrom();
210 
211  RemoveType() - removes the type attribute from the <message/>.
212
213                 $Mess->RemoveType();
214 
215  RemoveSubject() - removes the <subject/> element from the
216                    <message/>.
217
218                    $Mess->RemoveSubject();
219
220  RemoveBody() - removes the <body/> element from the
221                 <message/>.
222                 
223                 $Mess->RemoveBody();
224
225  RemoveThread() - removes the <thread/> element from the <message/>.
226
227                   $Mess->RemoveThread();
228 
229  RemoveError() - removes the <error/> element from the <message/>.
230
231                  $Mess->RemoveError();
232 
233  RemoveErrorCode() - removes the code attribute from the <error/>
234                      element in the <message/>.
235
236                      $Mess->RemoveErrorCode();
237
238=head2 Test functions
239
240  DefinedTo() - returns 1 if the to attribute is defined in the
241                <message/>, 0 otherwise.
242
243                $test = $Mess->DefinedTo();
244
245  DefinedFrom() - returns 1 if the from attribute is defined in the
246                  <message/>, 0 otherwise.
247
248                  $test = $Mess->DefinedFrom();
249
250  DefinedType() - returns 1 if the type attribute is defined in the
251                  <message/>, 0 otherwise.
252
253                  $test = $Mess->DefinedType();
254
255  DefinedSubject() - returns 1 if <subject/> is defined in the
256                     <message/>, 0 otherwise.
257
258                     $test = $Mess->DefinedSubject();
259
260  DefinedBody() - returns 1 if <body/> is defined in the <message/>,
261                  0 otherwise.
262
263                  $test = $Mess->DefinedBody();
264
265  DefinedThread() - returns 1 if <thread/> is defined in the <message/>,
266                    0 otherwise.
267
268                    $test = $Mess->DefinedThread();
269
270  DefinedErrorCode() - returns 1 if <error/> is defined in the
271                       <message/>, 0 otherwise.
272
273                       $test = $Mess->DefinedErrorCode();
274
275  DefinedError() - returns 1 if the code attribute is defined in the
276                   <error/>, 0 otherwise.
277
278                   $test = $Mess->DefinedError();
279
280=head1 AUTHOR
281
282Ryan Eatmon
283
284=head1 COPYRIGHT
285
286This module is free software, you can redistribute it and/or modify
287it under the same terms as Perl itself.
288
289=cut
290
291require 5.003;
292use strict;
293use Carp;
294use vars qw( %FUNCTIONS );
295use Net::XMPP::Stanza;
296use base qw( Net::XMPP::Stanza );
297
298sub new
299{
300    my $proto = shift;
301    my $class = ref($proto) || $proto;
302    my $self = {};
303
304    bless($self, $proto);
305
306    $self->{DEBUGHEADER} = "Message";
307    $self->{TAG} = "message";
308    $self->{TIMESTAMP} = &Net::XMPP::GetTimeStamp("local");
309
310    $self->{FUNCS} = \%FUNCTIONS;
311
312    $self->_init(@_);
313
314    return $self;
315}
316
317sub _message { my $self = shift; return new Net::XMPP::Message(); }
318
319
320$FUNCTIONS{Body}->{path}  = 'body/text()';
321
322$FUNCTIONS{Error}->{path} = 'error/text()';
323
324$FUNCTIONS{ErrorCode}->{path} = 'error/@code';
325
326$FUNCTIONS{From}->{type} = 'jid';
327$FUNCTIONS{From}->{path} = '@from';
328
329$FUNCTIONS{ID}->{path} = '@id';
330
331$FUNCTIONS{Subject}->{path} = 'subject/text()';
332
333$FUNCTIONS{Thread}->{path} = 'thread/text()';
334
335$FUNCTIONS{To}->{type} = 'jid';
336$FUNCTIONS{To}->{path} = '@to';
337
338$FUNCTIONS{Type}->{path} = '@type';
339
340$FUNCTIONS{XMLNS}->{path} = '@xmlns';
341
342$FUNCTIONS{Message}->{type}  = 'master';
343
344$FUNCTIONS{Child}->{type} = 'child';
345$FUNCTIONS{Child}->{path} = '*[@xmlns]';
346$FUNCTIONS{Child}->{child} = {};
347
348##############################################################################
349#
350# GetTimeStamp - returns a string with the time stamp of when this object
351#                was created.
352#
353##############################################################################
354sub GetTimeStamp
355{
356    my $self = shift;
357
358    if ($self->DefinedX("jabber:x:delay"))
359    {
360        my @xTags = $self->GetX("jabber:x:delay");
361        my $xTag = $xTags[0];
362        $self->{TIMESTAMP} = &Net::XMPP::GetTimeStamp("utcdelaylocal",$xTag->GetStamp());
363    }
364
365    return $self->{TIMESTAMP};
366}
367
368
369##############################################################################
370#
371# Reply - returns a Net::XMPP::Message object with the proper fields
372#         already populated for you.
373#
374##############################################################################
375sub Reply
376{
377    my $self = shift;
378    my %args;
379    while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
380
381    my $reply = $self->_message();
382
383    if (($self->GetType() eq "") || ($self->GetType() eq "normal"))
384    {
385        my $subject = $self->GetSubject();
386        $subject =~ s/re\:\s+//i;
387        $reply->SetSubject("re: $subject");
388    }
389    $reply->SetThread($self->GetThread()) if ($self->GetThread() ne "");
390    $reply->SetID($self->GetID()) if ($self->GetID() ne "");
391    $reply->SetType($self->GetType()) if ($self->GetType() ne "");
392    $reply->SetMessage((($self->GetFrom() ne "") ?
393                         (to=>$self->GetFrom()) :
394                         ()
395                        ),
396                        (($self->GetTo() ne "") ?
397                         (from=>$self->GetTo()) :
398                         ()
399                        ),
400                       );
401    $reply->SetMessage(%args);
402
403    return $reply;
404}
405
406
4071;
Note: See TracBrowser for help on using the repository browser.