source: perl/modules/Jabber/lib/Net/XMPP.pm @ c2bed55

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since c2bed55 was c2bed55, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
Moving Net::Jabber into Jabber.par
  • Property mode set to 100644
File size: 12.0 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;
23
24=head1 NAME
25
26Net::XMPP - XMPP Perl Library
27
28=head1 SYNOPSIS
29
30  Net::XMPP provides a Perl user with access to the Extensible
31  Messaging and Presence Protocol (XMPP).
32
33  For more information about XMPP visit:
34
35    http://www.xmpp.org
36
37=head1 DESCRIPTION
38
39  Net::XMPP is a convenient tool to use for any perl script that would
40  like to utilize the XMPP Instant Messaging protocol.  While not a
41  client in and of itself, it provides all of the necessary back-end
42  functions to make a CGI client or command-line perl client feasible
43  and easy to use.  Net::XMPP is a wrapper around the rest of the
44  official Net::XMPP::xxxxxx packages.
45
46  There is are example scripts in the example directory that provide you
47  with examples of very simple XMPP programs.
48
49
50  NOTE: The parser that XML::Stream::Parser provides, as are most Perl
51  parsers, is synchronous.  If you are in the middle of parsing a packet
52  and call a user defined callback, the Parser is blocked until your
53  callback finishes.  This means you cannot be operating on a packet,
54  send out another packet and wait for a response to that packet.  It
55  will never get to you.  Threading might solve this, but as of this
56  writing threading in Perl is not quite up to par yet.  This issue will
57  be revisted in the future.
58
59
60=head1 EXAMPLES
61
62      use Net::XMPP;
63      my $client = Net::XMPP::Client->new();
64
65=head1 METHODS
66
67  The Net::XMPP module does not define any methods that you will call
68  directly in your code.  Instead you will instantiate objects that call
69  functions from this module to do work.  The three main objects that
70  you will work with are the Message, Presence, and IQ modules. Each one
71  corresponds to the Jabber equivilant and allows you get and set all
72  parts of those packets.
73
74  There are a few functions that are the same across all of the objects:
75
76=head2 Retrieval functions
77
78  GetXML() - returns the XML string that represents the data contained
79             in the object.
80
81             $xml  = $obj->GetXML();
82
83  GetChild()          - returns an array of Net::XMPP::Stanza objects
84  GetChild(namespace)   that represent all of the stanzas in the object
85                        that are namespaced.  If you specify a namespace
86                        then only stanza objects with that XMLNS are
87                        returned.
88
89                        @xObj = $obj->GetChild();
90                        @xObj = $obj->GetChild("my:namespace");
91
92  GetTag() - return the root tag name of the packet.
93
94  GetTree() - return the XML::Stream::Node object that contains the data.
95              See XML::Stream::Node for methods you can call on this
96              object.
97
98=head2 Creation functions
99
100  NewChild(namespace)     - creates a new Net::XMPP::Stanza object with
101  NewChild(namespace,tag)   the specified namespace and root tag of
102                            whatever the namespace says its root tag
103                            should be.  Optionally you may specify
104                            another root tag if the default is not
105                            desired, or the namespace requres you to set
106                            one.
107
108                            $xObj = $obj->NewChild("my:namespace");
109                            $xObj = $obj->NewChild("my:namespace","foo");
110                              ie. <foo xmlns='my:namespace'...></foo>
111
112  InsertRawXML(string) - puts the specified string raw into the XML
113                         packet that you call this on.
114
115                         $message->InsertRawXML("<foo></foo>")
116                           <message...>...<foo></foo></message>
117
118                         $x = $message->NewChild(..);
119                         $x->InsertRawXML("test");
120
121                         $query = $iq->GetChild(..);
122                         $query->InsertRawXML("test");
123
124  ClearRawXML() - removes the raw XML from the packet.
125
126=head2 Removal functions
127
128  RemoveChild()          - removes all of the namespaces child elements
129  RemoveChild(namespace)   from the object.  If a namespace is provided,
130                           then only the children with that namespace are
131                           removed.
132
133=head2 Test functions
134
135  DefinedChild()          - returns 1 if there are any known namespaced
136  DefinedChild(namespace)   stanzas in the packet, 0 otherwise.
137                            Optionally you can specify a namespace and
138                            determine if there are any stanzas with that
139                            namespace.
140
141                            $test = $obj->DefinedChild();
142                            $test = $obj->DefinedChild("my:namespace");
143
144=head1 PACKAGES
145
146  For more information on each of these packages, please see the man page
147  for each one.
148
149=head2 Net::XMPP::Client
150
151  This package contains the code needed to communicate with an XMPP
152  server: login, wait for messages, send messages, and logout.  It uses
153  XML::Stream to read the stream from the server and based on what kind
154  of tag it encounters it calls a function to handle the tag.
155
156=head2 Net::XMPP::Protocol
157
158  A collection of high-level functions that Client uses to make their
159  lives easier.  These methods are inherited by the Client.
160
161=head2 Net::XMPP::JID
162
163  The XMPP IDs consist of three parts: user id, server, and resource.
164  This module gives you access to those components without having to
165  parse the string yourself.
166
167=head2 Net::XMPP::Message
168
169  Everything needed to create and read a <message/> received from the
170  server.
171
172=head2 Net::XMPP::Presence
173
174  Everything needed to create and read a <presence/> received from the
175  server.
176
177=head2 Net::XMPP::IQ
178
179  IQ is a wrapper around a number of modules that provide support for
180  the various Info/Query namespaces that XMPP recognizes.
181
182=head2 Net::XMPP::Stanza
183
184  This module represents a namespaced stanza that is used to extend a
185  <message/>, <presence/>, and <iq/>.
186
187  The man page for Net::XMPP::Stanza contains a listing of all supported
188  namespaces, and the methods that are supported by the objects that
189  represent those namespaces.
190
191=head2 Net::XMPP::Namespaces
192
193  XMPP allows for any stanza to be extended by any bit of XML.  This
194  module contains all of the internals for defining the XMPP based
195  extensions defined by the IETF.  The documentation for this module
196  explains more about how to add your own custom namespace and have it
197  be supported.
198
199=head1 AUTHOR
200
201Ryan Eatmon
202
203=head1 COPYRIGHT
204
205This module is free software, you can redistribute it and/or modify it
206under the same terms as Perl itself.
207
208=cut
209
210require 5.005;
211use strict;
212use XML::Stream 1.22 qw( Node );
213use Time::Local;
214use Carp;
215use Digest::SHA1;
216use Authen::SASL;
217use MIME::Base64;
218use POSIX;
219use vars qw( $AUTOLOAD $VERSION $PARSING );
220
221$VERSION = "1.0";
222
223use Net::XMPP::Debug;
224use Net::XMPP::JID;
225use Net::XMPP::Namespaces;
226use Net::XMPP::Stanza;
227use Net::XMPP::Message;
228use Net::XMPP::IQ;
229use Net::XMPP::Presence;
230use Net::XMPP::Protocol;
231use Net::XMPP::Client;
232
233
234##############################################################################
235#
236# printData - debugging function to print out any data structure in an
237#             organized manner.  Very useful for debugging XML::Parser::Tree
238#             objects.  This is a private function that will only exist in
239#             in the development version.
240#
241##############################################################################
242sub printData
243{
244    print &sprintData(@_);
245}
246
247
248##############################################################################
249#
250# sprintData - debugging function to build a string out of any data structure
251#              in an organized manner.  Very useful for debugging
252#              XML::Parser::Tree objects and perl hashes of hashes.
253#
254#              This is a private function.
255#
256##############################################################################
257sub sprintData
258{
259    return &XML::Stream::sprintData(@_);
260}
261
262
263##############################################################################
264#
265# GetTimeStamp - generic funcion for getting a timestamp.
266#
267##############################################################################
268sub GetTimeStamp
269{
270    my($type,$time,$length) = @_;
271
272    return "" if (($type ne "local") && ($type ne "utc") && !($type =~ /^(local|utc)delay(local|utc|time)$/));
273
274    $length = "long" unless defined($length);
275
276    my ($sec,$min,$hour,$mday,$mon,$year,$wday);
277    if ($type =~ /utcdelay/)
278    {
279        ($year,$mon,$mday,$hour,$min,$sec) = ($time =~ /^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)\:(\d\d)\:(\d\d)$/);
280        $mon--;
281        ($type) = ($type =~ /^utcdelay(.*)$/);
282        $time = timegm($sec,$min,$hour,$mday,$mon,$year);
283    }
284    if ($type =~ /localdelay/)
285    {
286        ($year,$mon,$mday,$hour,$min,$sec) = ($time =~ /^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)\:(\d\d)\:(\d\d)$/);
287        $mon--;
288        ($type) = ($type =~ /^localdelay(.*)$/);
289        $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
290    }
291
292    return $time if ($type eq "time");
293    ($sec,$min,$hour,$mday,$mon,$year,$wday) =
294        localtime(((defined($time) && ($time ne "")) ? $time : time)) if ($type eq "local");
295    ($sec,$min,$hour,$mday,$mon,$year,$wday) =
296        gmtime(((defined($time) && ($time ne "")) ? $time : time)) if ($type eq "utc");
297
298    return sprintf("%d%02d%02dT%02d:%02d:%02d",($year + 1900),($mon+1),$mday,$hour,$min,$sec) if ($length eq "stamp");
299
300    $wday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$wday];
301
302    my $month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
303    $mon++;
304
305    return sprintf("%3s %3s %02d, %d %02d:%02d:%02d",$wday,$month,$mday,($year + 1900),$hour,$min,$sec) if ($length eq "long");
306    return sprintf("%3s %d/%02d/%02d %02d:%02d",$wday,($year + 1900),$mon,$mday,$hour,$min) if ($length eq "normal");
307    return sprintf("%02d:%02d:%02d",$hour,$min,$sec) if ($length eq "short");
308    return sprintf("%02d:%02d",$hour,$min) if ($length eq "shortest");
309}
310
311
312##############################################################################
313#
314# GetHumanTime - convert seconds, into a human readable time string.
315#
316##############################################################################
317sub GetHumanTime
318{
319    my $seconds = shift;
320
321    my $minutes = 0;
322    my $hours = 0;
323    my $days = 0;
324    my $weeks = 0;
325
326    while ($seconds >= 60) {
327        $minutes++;
328        if ($minutes == 60) {
329            $hours++;
330            if ($hours == 24) {
331                $days++;
332                if ($days == 7) {
333                    $weeks++;
334                    $days -= 7;
335                }
336                $hours -= 24;
337            }
338            $minutes -= 60;
339        }
340        $seconds -= 60;
341    }
342
343    my $humanTime;
344    $humanTime .= "$weeks week " if ($weeks == 1);
345    $humanTime .= "$weeks weeks " if ($weeks > 1);
346    $humanTime .= "$days day " if ($days == 1);
347    $humanTime .= "$days days " if ($days > 1);
348    $humanTime .= "$hours hour " if ($hours == 1);
349    $humanTime .= "$hours hours " if ($hours > 1);
350    $humanTime .= "$minutes minute " if ($minutes == 1);
351    $humanTime .= "$minutes minutes " if ($minutes > 1);
352    $humanTime .= "$seconds second " if ($seconds == 1);
353    $humanTime .= "$seconds seconds " if ($seconds > 1);
354
355    $humanTime = "none" if ($humanTime eq "");
356
357    return $humanTime;
358}
359
3601;
Note: See TracBrowser for help on using the repository browser.