File Coverage

blib/lib/Net/XMPP/JID.pm
Criterion Covered Total %
statement 44 80 55.0
branch 14 32 43.7
condition 2 15 13.3
subroutine 9 15 60.0
pod 6 12 50.0
total 75 154 48.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::JID;
23              
24             =head1 NAME
25              
26             Net::XMPP::JID - XMPP JID Module
27              
28             =head1 SYNOPSIS
29              
30             Net::XMPP::JID is a companion to the Net::XMPP module.
31             It provides the user a simple interface to set and retrieve all
32             parts of a Jabber ID (userid on a server).
33              
34             =head1 DESCRIPTION
35              
36             To initialize the JID you must pass it the string that represents the
37             jid from the XML packet. Inside the XMPP modules this is done
38             automatically and the JID object is returned instead of a string.
39             For example, in the callback function for the XMPP object foo:
40              
41             use Net::XMPP;
42              
43             sub foo {
44             my $foo = Net::XMPP::Foo->new(@_);
45             my $from = $foo->GetFrom();
46             my $JID = Net::XMPP::JID->new($from);
47             .
48             .
49             .
50             }
51              
52             You now have access to all of the retrieval functions available.
53              
54             To create a new JID to send to the server:
55              
56             use Net::XMPP;
57              
58             $JID = Net::XMPP::JID->new();
59              
60             Now you can call the creation functions below to populate the tag
61             before sending it.
62              
63             =head2 Retrieval functions
64              
65             $userid = $JID->GetUserID();
66             $server = $JID->GetServer();
67             $resource = $JID->GetResource();
68              
69             $JID = $JID->GetJID();
70             $fullJID = $JID->GetJID("full");
71             $baseJID = $JID->GetJID("base");
72              
73             =head2 Creation functions
74              
75             $JID->SetJID(userid=>"bob",
76             server=>"jabber.org",
77             resource=>"Work");
78              
79             $JID->SetJID('blue@moon.org/Home');
80              
81             $JID->SetUserID("foo");
82             $JID->SetServer("bar.net");
83             $JID->SetResource("Foo Bar");
84              
85             =head1 METHODS
86              
87             =head2 Retrieval functions
88              
89             =over 4
90              
91             =item GetUserID
92              
93             GetUserID()
94              
95             returns a string with the userid of the JID.
96             If the string is an address (bob%jabber.org) then
97             the function will return it as an address
98             (bob@jabber.org).
99              
100             =item GetServer
101              
102             GetServer()
103              
104             returns a string with the server of the JID.
105              
106             =item GerResource
107              
108             GetResource()
109              
110             returns a string with the resource of the JID.
111              
112             =item GetJID
113              
114             GetJID()
115             GetJID("full")
116             GetJID("base")
117             returns a string that represents the JID stored
118             within. If the "full" string is specified, then
119             you get the full JID, including Resource, which
120             should be used to send to the server. If the "base",
121             string is specified, then you will just get
122             user@server, or the base JID.
123              
124             =back
125              
126             =head2 Creation functions
127              
128             =over 4
129              
130             =item SetJID
131              
132             SetJID(userid=>string,
133             server=>string,
134             resource=>string)
135             SetJID(string)
136              
137             set multiple fields in the jid at
138             one time. This is a cumulative
139             and over writing action. If you set
140             the "userid" attribute twice, the second
141             setting is what is used. If you set
142             the server, and then set the resource
143             then both will be in the jid. If all
144             you pass is a string, then that string
145             is used as the JID. For valid settings
146             read the specific Set functions below.
147              
148             =item SetUserID
149              
150             SetUserID(string)
151              
152             sets the userid. Must be a valid userid or the
153             server will complain if you try to use this JID
154             to talk to the server. If the string is an
155             address then it will be converted to the %
156             form suitable for using as a User ID.
157              
158             =item SerServer
159              
160             SetServer(string)
161              
162             sets the server. Must be a valid host on the
163             network or the server will not be able to talk
164             to it.
165              
166             =item SetResource
167              
168             SetResource(string)
169              
170             sets the resource of the userid to talk to.
171              
172             =back
173              
174             =head1 AUTHOR
175              
176             Originally authored by Ryan Eatmon.
177              
178             Previously maintained by Eric Hacker.
179              
180             Currently maintained by Darian Anthony Patrick.
181              
182             =head1 COPYRIGHT
183              
184             This module is free software, you can redistribute it and/or modify it
185             under the LGPL 2.1.
186              
187             =cut
188              
189             require 5.008;
190 15     15   83 use strict;
  15         20  
  15         538  
191 15     15   63 use warnings;
  15         22  
  15         367  
192 15     15   58 use Carp;
  15         19  
  15         13439  
193              
194             sub new
195             {
196 35     35 0 1743 my $proto = shift;
197 35   33     145 my $class = ref($proto) || $proto;
198 35         59 my $self = { };
199              
200 35         104 bless($self, $proto);
201              
202 35 50       133 if ("@_" ne (""))
203             {
204 35         53 my ($jid) = @_;
205 35 50 33     140 return $jid if ((ref($jid) ne "") && ($jid->isa("Net::XMPP::JID")));
206 35         136 $self->{JID} = $jid;
207             }
208             else
209             {
210 0         0 $self->{JID} = "";
211             }
212 35         88 $self->ParseJID();
213              
214 35         250 return $self;
215             }
216              
217              
218             ##############################################################################
219             #
220             # ParseJID - private helper function that takes the JID and sets the
221             # the three parts of it.
222             #
223             ##############################################################################
224             sub ParseJID
225             {
226 35     35 0 47 my $self = shift;
227              
228 35         43 my $userid;
229             my $server;
230 0         0 my $resource;
231              
232 35         297 ($userid,$server,$resource) =
233             ($self->{JID} =~ /^([^\@\/'"&:<>]*)\@([A-Za-z0-9\.\-\_]+)\/?(.*?)$/);
234 35 100       108 if (!defined($server))
235             {
236 1         8 ($server,$resource) =
237             ($self->{JID} =~ /^([A-Za-z0-9\.\-\_]+)\/?(.*?)$/);
238             }
239              
240 35 100       75 $userid = "" unless defined($userid);
241 35 50       88 $server = "" unless defined($server);
242 35 50       63 $resource = "" unless defined($resource);
243              
244 35         60 $self->{USERID} = $userid;
245 35         52 $self->{SERVER} = $server;
246 35         72 $self->{RESOURCE} = $resource;
247             }
248              
249              
250             ##############################################################################
251             #
252             # BuildJID - private helper function that takes the three parts and sets the
253             # JID from them.
254             #
255             ##############################################################################
256             sub BuildJID
257             {
258 0     0 0 0 my $self = shift;
259 0         0 $self->{JID} = $self->{USERID};
260 0 0       0 $self->{JID} .= "\@" if ($self->{USERID} ne "");
261 0 0 0     0 $self->{JID} .= $self->{SERVER} if (exists($self->{SERVER}) &&
262             defined($self->{SERVER}));
263 0 0 0     0 $self->{JID} .= "/".$self->{RESOURCE} if (exists($self->{RESOURCE}) &&
      0        
264             defined($self->{RESOURCE}) &&
265             ($self->{RESOURCE} ne ""));
266             }
267              
268              
269             ##############################################################################
270             #
271             # GetUserID - returns the userid of the JID.
272             #
273             ##############################################################################
274             sub GetUserID
275             {
276 26     26 1 15261 my $self = shift;
277 26         57 my $userid = $self->{USERID};
278 26         57 $userid =~ s/\%/\@/;
279 26         130 return $userid;
280             }
281              
282              
283             ##############################################################################
284             #
285             # GetServer - returns the server of the JID.
286             #
287             ##############################################################################
288             sub GetServer
289             {
290 26     26 1 46 my $self = shift;
291 26         148 return $self->{SERVER};
292             }
293              
294              
295             ##############################################################################
296             #
297             # GetResource - returns the resource of the JID.
298             #
299             ##############################################################################
300             sub GetResource
301             {
302 26     26 0 44 my $self = shift;
303 26         182 return $self->{RESOURCE};
304             }
305              
306              
307             ##############################################################################
308             #
309             # GetJID - returns the full jid of the JID.
310             #
311             ##############################################################################
312             sub GetJID
313             {
314 15     15 1 2587 my $self = shift;
315 15         19 my $type = shift;
316 15 100       37 $type = "" unless defined($type);
317 15 100       107 return $self->{JID} if ($type eq "full");
318 13 100       66 return $self->{USERID}."\@".$self->{SERVER} if ($self->{USERID} ne "");
319 1         5 return $self->{SERVER};
320             }
321              
322              
323             ##############################################################################
324             #
325             # SetJID - takes a hash of all of the things you can set on a JID and sets
326             # each one.
327             #
328             ##############################################################################
329             sub SetJID
330             {
331 0     0 1   my $self = shift;
332 0           my %jid;
333              
334 0 0         if ($#_ > 0 ) {
335 0           while($#_ >= 0) { $jid{ lc pop(@_) } = pop(@_); }
  0            
336              
337 0 0         $self->SetUserID($jid{userid}) if exists($jid{userid});
338 0 0         $self->SetServer($jid{server}) if exists($jid{server});
339 0 0         $self->SetResource($jid{resource}) if exists($jid{resource});
340             } else {
341 0           ($self->{JID}) = @_;
342 0           $self->ParseJID();
343             }
344             }
345              
346              
347             ##############################################################################
348             #
349             # SetUserID - sets the userid of the JID.
350             #
351             ##############################################################################
352             sub SetUserID
353             {
354 0     0 1   my $self = shift;
355 0           my ($userid) = @_;
356 0           $userid =~ s/\@/\%/;
357 0           $self->{USERID} = $userid;
358 0           $self->BuildJID();
359             }
360              
361              
362             ##############################################################################
363             #
364             # SetServer - sets the server of the JID.
365             #
366             ##############################################################################
367             sub SetServer
368             {
369 0     0 0   my $self = shift;
370 0           my ($server) = @_;
371 0           $self->{SERVER} = $server;
372 0           $self->BuildJID();
373             }
374              
375              
376             ##############################################################################
377             #
378             # SetResource - sets the resource of the JID.
379             #
380             ##############################################################################
381             sub SetResource
382             {
383 0     0 1   my $self = shift;
384 0           my ($resource) = @_;
385 0           $self->{RESOURCE} = $resource;
386 0           $self->BuildJID();
387             }
388              
389              
390             ##############################################################################
391             #
392             # debug - prints out the contents of the JID
393             #
394             ##############################################################################
395             sub debug
396             {
397 0     0 0   my $self = shift;
398              
399 0           print "debug JID: $self\n";
400 0           print "UserID: (",$self->{USERID},")\n";
401 0           print "Server: (",$self->{SERVER},")\n";
402 0           print "Resource: (",$self->{RESOURCE},")\n";
403 0           print "JID: (",$self->{JID},")\n";
404             }
405              
406              
407             1;