File Coverage

blib/lib/Net/XMPP.pm
Criterion Covered Total %
statement 59 102 57.8
branch 9 56 16.0
condition 3 12 25.0
subroutine 16 19 84.2
pod 0 4 0.0
total 87 193 45.0


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;
23              
24             =head1 NAME
25              
26             Net::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             L
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 L 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             =over 4
79              
80             =item GetXML
81              
82             Returns the XML string that represents the data contained
83             in the object.
84              
85             $xml = $obj->GetXML();
86              
87             =item GetChild
88              
89             Returns an array of L objects
90             that represent all of the stanzas in the object
91             that are namespaced. If you specify a namespace
92             then only stanza objects with that XMLNS are
93             returned.
94              
95             @xObj = $obj->GetChild();
96             @xObj = $obj->GetChild("my:namespace");
97              
98             =item GetTag
99              
100             Return the root tag name of the packet.
101              
102             =item GetTree
103              
104             Return the L object that contains the data.
105             See XML::Stream::Node for methods you can call on this
106             object.
107              
108             =back
109              
110             =head2 Creation functions
111              
112             =over 4
113              
114             =item NewChild
115              
116             NewChild(namespace)
117             NewChild(namespace,tag)
118              
119             Creates a new Net::XMPP::Stanza object with
120             the specified namespace and root tag of
121             whatever the namespace says its root tag
122             should be. Optionally you may specify
123             another root tag if the default is not
124             desired, or the namespace requres you to set
125             one.
126              
127             $xObj = $obj->NewChild("my:namespace");
128             $xObj = $obj->NewChild("my:namespace","foo");
129              
130             ie.
131              
132             =item InsertRawXML
133              
134             InsertRawXML(string)
135              
136             puts the specified string raw into the XML
137             packet that you call this on.
138              
139             $message->InsertRawXML("")
140             ...
141              
142             $x = $message->NewChild(..);
143             $x->InsertRawXML("test");
144              
145             $query = $iq->GetChild(..);
146             $query->InsertRawXML("test");
147              
148             =item ClearRawXML
149              
150             ClearRawXML()
151              
152             Removes the raw XML from the packet.
153              
154             =back
155              
156             =head2 Removal functions
157              
158             =over 4
159              
160             =item RemoveChild
161              
162             RemoveChild()
163             RemoveChild(namespace)
164              
165             Removes all of the namespaces child elements
166             from the object. If a namespace is provided,
167             then only the children with that namespace are
168             removed.
169              
170             =back
171              
172             =head2 Test functions
173              
174             =over 4
175              
176             =item DefinedChild
177              
178             DefinedChild()
179             DefinedChild(namespace)
180              
181             Returns 1 if there are any known namespaced
182             stanzas in the packet, 0 otherwise.
183             Optionally you can specify a namespace and
184             determine if there are any stanzas with that
185             namespace.
186              
187             $test = $obj->DefinedChild();
188             $test = $obj->DefinedChild("my:namespace");
189              
190             =back
191              
192             =head1 PACKAGES
193              
194             For more information on each of these packages, please see the man page
195             for each one.
196              
197             =head2 Net::XMPP::Client
198              
199             This package contains the code needed to communicate with an XMPP
200             server: login, wait for messages, send messages, and logout. It uses
201             XML::Stream to read the stream from the server and based on what kind
202             of tag it encounters it calls a function to handle the tag.
203              
204             =head2 Net::XMPP::Protocol
205              
206             A collection of high-level functions that Client uses to make their
207             lives easier. These methods are inherited by the Client.
208              
209             =head2 Net::XMPP::JID
210              
211             The XMPP IDs consist of three parts: user id, server, and resource.
212             This module gives you access to those components without having to
213             parse the string yourself.
214              
215             =head2 Net::XMPP::Message
216              
217             Everything needed to create and read a received from the
218             server.
219              
220             =head2 Net::XMPP::Presence
221              
222             Everything needed to create and read a received from the
223             server.
224              
225             =head2 Net::XMPP::IQ
226              
227             IQ is a wrapper around a number of modules that provide support for
228             the various Info/Query namespaces that XMPP recognizes.
229              
230             =head2 Net::XMPP::Stanza
231              
232             This module represents a namespaced stanza that is used to extend a
233             , , and .
234              
235             The man page for Net::XMPP::Stanza contains a listing of all supported
236             namespaces, and the methods that are supported by the objects that
237             represent those namespaces.
238              
239             =head2 Net::XMPP::Namespaces
240              
241             XMPP allows for any stanza to be extended by any bit of XML. This
242             module contains all of the internals for defining the XMPP based
243             extensions defined by the IETF. The documentation for this module
244             explains more about how to add your own custom namespace and have it
245             be supported.
246              
247             =head1 AUTHOR
248              
249             Originally authored by Ryan Eatmon.
250              
251             Previously maintained by Eric Hacker.
252              
253             Currently maintained by Darian Anthony Patrick.
254              
255             =head1 BUGS
256              
257             See unpatched issues at L.
258              
259             There is at least one issue with L providing different
260             node structures depending on how the node is created. Net::XMPP
261             should now be able to handle this, but who knows what else lurks.
262              
263             =head1 COPYRIGHT
264              
265             This module is free software, you can redistribute it and/or modify it
266             under the LGPL 2.1.
267              
268             =cut
269              
270             require 5.008;
271 15     15   337964 use strict;
  15         30  
  15         605  
272 15     15   64 use warnings;
  15         26  
  15         425  
273 15     15   7282 use Time::Local;
  15         22073  
  15         967  
274 15     15   8142 use POSIX;
  15         84974  
  15         94  
275 15     15   35541 use vars qw( $AUTOLOAD $VERSION $PARSING );
  15         31  
  15         1044  
276              
277             $VERSION = "1.02_05";
278              
279 15     15   14973 use XML::Stream;
  15         1138786  
  15         133  
280 15     15   9061 use Net::XMPP::Debug;
  15         35  
  15         463  
281 15     15   7299 use Net::XMPP::JID;
  15         25  
  15         461  
282 15     15   8332 use Net::XMPP::Namespaces;
  15         33  
  15         527  
283 15     15   9077 use Net::XMPP::Stanza;
  15         42  
  15         590  
284 15     15   9284 use Net::XMPP::Message;
  15         34  
  15         438  
285 15     15   7391 use Net::XMPP::IQ;
  15         32  
  15         507  
286 15     15   7158 use Net::XMPP::Presence;
  15         31  
  15         399  
287 15     15   13994 use Net::XMPP::Protocol;
  15         46  
  15         636  
288 15     15   8848 use Net::XMPP::Client;
  15         46  
  15         10724  
289              
290              
291             ##############################################################################
292             #
293             # printData - debugging function to print out any data structure in an
294             # organized manner. Very useful for debugging XML::Parser::Tree
295             # objects. This is a private function that will only exist in
296             # in the development version.
297             #
298             ##############################################################################
299             sub printData
300             {
301 0     0 0 0 print &sprintData(@_);
302             }
303              
304              
305             ##############################################################################
306             #
307             # sprintData - debugging function to build a string out of any data structure
308             # in an organized manner. Very useful for debugging
309             # XML::Parser::Tree objects and perl hashes of hashes.
310             #
311             # This is a private function.
312             #
313             ##############################################################################
314             sub sprintData
315             {
316 0     0 0 0 return &XML::Stream::sprintData(@_);
317             }
318              
319              
320             ##############################################################################
321             #
322             # GetTimeStamp - generic funcion for getting a timestamp.
323             #
324             ##############################################################################
325             sub GetTimeStamp
326             {
327 4     4 0 8 my($type,$time,$length) = @_;
328              
329 4 0 33     17 return "" if (($type ne "local") && ($type ne "utc") && !($type =~ /^(local|utc)delay(local|utc|time)$/));
      33        
330              
331 4 50       10 $length = "long" unless defined($length);
332              
333 4         4 my ($sec,$min,$hour,$mday,$mon,$year,$wday);
334 4 50       11 if ($type =~ /utcdelay/)
335             {
336 0         0 ($year,$mon,$mday,$hour,$min,$sec) = ($time =~ /^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)\:(\d\d)\:(\d\d)$/);
337 0         0 $mon--;
338 0         0 ($type) = ($type =~ /^utcdelay(.*)$/);
339 0         0 $time = timegm($sec,$min,$hour,$mday,$mon,$year);
340             }
341 4 50       14 if ($type =~ /localdelay/)
342             {
343 0         0 ($year,$mon,$mday,$hour,$min,$sec) = ($time =~ /^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)\:(\d\d)\:(\d\d)$/);
344 0         0 $mon--;
345 0         0 ($type) = ($type =~ /^localdelay(.*)$/);
346 0         0 $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
347             }
348              
349 4 50       13 return $time if ($type eq "time");
350 4 50 33     187 ($sec,$min,$hour,$mday,$mon,$year,$wday) =
    50          
351             localtime(((defined($time) && ($time ne "")) ? $time : time)) if ($type eq "local");
352 4 0 0     15 ($sec,$min,$hour,$mday,$mon,$year,$wday) =
    50          
353             gmtime(((defined($time) && ($time ne "")) ? $time : time)) if ($type eq "utc");
354              
355 4 50       11 return sprintf("%d%02d%02dT%02d:%02d:%02d",($year + 1900),($mon+1),$mday,$hour,$min,$sec) if ($length eq "stamp");
356              
357 4         14 $wday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$wday];
358              
359 4         12 my $month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
360 4         5 $mon++;
361              
362 4 50       58 return sprintf("%3s %3s %02d, %d %02d:%02d:%02d",$wday,$month,$mday,($year + 1900),$hour,$min,$sec) if ($length eq "long");
363 0 0         return sprintf("%3s %d/%02d/%02d %02d:%02d",$wday,($year + 1900),$mon,$mday,$hour,$min) if ($length eq "normal");
364 0 0         return sprintf("%02d:%02d:%02d",$hour,$min,$sec) if ($length eq "short");
365 0 0         return sprintf("%02d:%02d",$hour,$min) if ($length eq "shortest");
366             }
367              
368              
369             ##############################################################################
370             #
371             # GetHumanTime - convert seconds, into a human readable time string.
372             #
373             ##############################################################################
374             sub GetHumanTime
375             {
376 0     0 0   my $seconds = shift;
377              
378 0           my $minutes = 0;
379 0           my $hours = 0;
380 0           my $days = 0;
381 0           my $weeks = 0;
382              
383 0           while ($seconds >= 60) {
384 0           $minutes++;
385 0 0         if ($minutes == 60) {
386 0           $hours++;
387 0 0         if ($hours == 24) {
388 0           $days++;
389 0 0         if ($days == 7) {
390 0           $weeks++;
391 0           $days -= 7;
392             }
393 0           $hours -= 24;
394             }
395 0           $minutes -= 60;
396             }
397 0           $seconds -= 60;
398             }
399              
400 0           my $humanTime;
401 0 0         $humanTime .= "$weeks week " if ($weeks == 1);
402 0 0         $humanTime .= "$weeks weeks " if ($weeks > 1);
403 0 0         $humanTime .= "$days day " if ($days == 1);
404 0 0         $humanTime .= "$days days " if ($days > 1);
405 0 0         $humanTime .= "$hours hour " if ($hours == 1);
406 0 0         $humanTime .= "$hours hours " if ($hours > 1);
407 0 0         $humanTime .= "$minutes minute " if ($minutes == 1);
408 0 0         $humanTime .= "$minutes minutes " if ($minutes > 1);
409 0 0         $humanTime .= "$seconds second " if ($seconds == 1);
410 0 0         $humanTime .= "$seconds seconds " if ($seconds > 1);
411              
412 0 0         $humanTime = "none" if ($humanTime eq "");
413              
414 0           return $humanTime;
415             }
416              
417             1;