source: perl/lib/Net/XMPP/JID.pm @ cb54527

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since cb54527 was cb54527, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
Getting rid of indirect object syntax new calls. Quoting perlobj: > But what if there are no arguments? In that case, Perl must guess what > you want. Even worse, it must make that guess *at compile time*. Usually > Perl gets it right, but when it doesn't you get a function call compiled > as a method, or vice versa. This can introduce subtle bugs that are hard > to detect. > > For example, a call to a method "new" in indirect notation -- as C++ > programmers are wont to make -- can be miscompiled into a subroutine > call if there's already a "new" function in scope. You'd end up calling > the current package's "new" as a subroutine, rather than the desired > class's method. The compiler tries to cheat by remembering bareword > "require"s, but the grief when it messes up just isn't worth the years > of debugging it will take you to track down such subtle bugs.
  • Property mode set to 100644
File size: 9.9 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::JID;
23
24=head1 NAME
25
26Net::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  GetUserID() - returns a string with the userid of the JID.
90                If the string is an address (bob%jabber.org) then
91                the function will return it as an address
92                (bob@jabber.org).
93
94  GetServer() - returns a string with the server of the JID.
95
96  GetResource() - returns a string with the resource of the JID.
97
98  GetJID()       - returns a string that represents the JID stored
99  GetJID("full")   within.  If the "full" string is specified, then
100  GetJID("base")   you get the full JID, including Resource, which
101                   should be used to send to the server.  If the "base",
102                   string is specified, then you will just get
103                   user@server, or the base JID.
104
105=head2 Creation functions
106
107  SetJID(userid=>string,   - set multiple fields in the jid at
108         server=>string,     one time.  This is a cumulative
109         resource=>string)   and over writing action.  If you set
110  SetJID(string)             the "userid" attribute twice, the second
111                             setting is what is used.  If you set
112                             the server, and then set the resource
113                             then both will be in the jid.  If all
114                             you pass is a string, then that string
115                             is used as the JID.  For valid settings
116                             read the specific Set functions below.
117
118  SetUserID(string) - sets the userid.  Must be a valid userid or the
119                      server will complain if you try to use this JID
120                      to talk to the server.  If the string is an
121                      address then it will be converted to the %
122                      form suitable for using as a User ID.
123
124  SetServer(string) - sets the server.  Must be a valid host on the
125                      network or the server will not be able to talk
126                      to it.
127
128  SetResource(string) - sets the resource of the userid to talk to.
129
130=head1 AUTHOR
131
132Ryan Eatmon
133
134=head1 COPYRIGHT
135
136This module is free software; you can redistribute it and/or modify
137it under the same terms as Perl itself.
138
139=cut
140
141require 5.003;
142use strict;
143use Carp;
144
145sub new
146{
147    my $proto = shift;
148    my $class = ref($proto) || $proto;
149    my $self = { };
150
151    bless($self, $proto);
152
153    if ("@_" ne (""))
154    {
155        my ($jid) = @_;
156        return $jid if ((ref($jid) ne "") && ($jid->isa("Net::XMPP::JID")));
157        $self->{JID} = $jid;
158    }
159    else
160    {
161        $self->{JID} = "";
162    }
163    $self->ParseJID();
164
165    return $self;
166}
167
168
169##############################################################################
170#
171# ParseJID - private helper function that takes the JID and sets the
172#            the three parts of it.
173#
174##############################################################################
175sub ParseJID
176{
177    my $self = shift;
178
179    my $userid;
180    my $server;
181    my $resource;
182
183    ($userid,$server,$resource) =
184        ($self->{JID} =~ /^([^\@\/'"&:<>]*)\@([A-Za-z0-9\.\-\_]+)\/?(.*?)$/);
185    if (!defined($server))
186    {
187        ($server,$resource) =
188            ($self->{JID} =~ /^([A-Za-z0-9\.\-\_]+)\/?(.*?)$/);
189    }
190
191    $userid = "" unless defined($userid);
192    $server = "" unless defined($server);
193    $resource = "" unless defined($resource);
194
195    $self->{USERID} = $userid;
196    $self->{SERVER} = $server;
197    $self->{RESOURCE} = $resource;
198}
199
200
201##############################################################################
202#
203# BuildJID - private helper function that takes the three parts and sets the
204#            JID from them.
205#
206##############################################################################
207sub BuildJID
208{
209    my $self = shift;
210    $self->{JID} = $self->{USERID};
211    $self->{JID} .= "\@" if ($self->{USERID} ne "");
212    $self->{JID} .= $self->{SERVER} if (exists($self->{SERVER}) &&
213                        defined($self->{SERVER}));
214    $self->{JID} .= "/".$self->{RESOURCE} if (exists($self->{RESOURCE}) &&
215                        defined($self->{RESOURCE}) &&
216                        ($self->{RESOURCE} ne ""));
217}
218
219
220##############################################################################
221#
222# GetUserID - returns the userid of the JID.
223#
224##############################################################################
225sub GetUserID
226{
227    my $self = shift;
228    my $userid = $self->{USERID};
229    $userid =~ s/\%/\@/;
230    return $userid;
231}
232
233
234##############################################################################
235#
236# GetServer - returns the server of the JID.
237#
238##############################################################################
239sub GetServer
240{
241    my $self = shift;
242    return $self->{SERVER};
243}
244
245
246##############################################################################
247#
248# GetResource - returns the resource of the JID.
249#
250##############################################################################
251sub GetResource
252{
253    my $self = shift;
254    return $self->{RESOURCE};
255}
256
257
258##############################################################################
259#
260# GetJID - returns the full jid of the JID.
261#
262##############################################################################
263sub GetJID
264{
265    my $self = shift;
266    my $type = shift;
267    $type = "" unless defined($type);
268    return $self->{JID} if ($type eq "full");
269    return $self->{USERID}."\@".$self->{SERVER} if ($self->{USERID} ne "");
270    return $self->{SERVER};
271}
272
273
274##############################################################################
275#
276# SetJID - takes a hash of all of the things you can set on a JID and sets
277#          each one.
278#
279##############################################################################
280sub SetJID
281{
282    my $self = shift;
283    my %jid;
284
285    if ($#_ > 0 ) { 
286        while($#_ >= 0) { $jid{ lc pop(@_) } = pop(@_); }
287
288        $self->SetUserID($jid{userid}) if exists($jid{userid});
289        $self->SetServer($jid{server}) if exists($jid{server});
290        $self->SetResource($jid{resource}) if exists($jid{resource});
291    } else {
292        ($self->{JID}) = @_;
293        $self->ParseJID();
294    }
295}
296
297
298##############################################################################
299#
300# SetUserID - sets the userid of the JID.
301#
302##############################################################################
303sub SetUserID
304{
305    my $self = shift;
306    my ($userid) = @_;
307    $userid =~ s/\@/\%/;
308    $self->{USERID} = $userid;
309    $self->BuildJID();
310}
311
312
313##############################################################################
314#
315# SetServer - sets the server of the JID.
316#
317##############################################################################
318sub SetServer
319{
320    my $self = shift;
321    my ($server) = @_;
322    $self->{SERVER} = $server;
323    $self->BuildJID();
324}
325
326
327##############################################################################
328#
329# SetResource - sets the resource of the JID.
330#
331##############################################################################
332sub SetResource
333{
334    my $self = shift;
335    my ($resource) = @_;
336    $self->{RESOURCE} = $resource;
337    $self->BuildJID();
338}
339
340
341##############################################################################
342#
343# debug - prints out the contents of the JID
344#
345##############################################################################
346sub debug
347{
348    my $self = shift;
349
350    print "debug JID: $self\n";
351    print "UserID:   (",$self->{USERID},")\n";
352    print "Server:   (",$self->{SERVER},")\n";
353    print "Resource: (",$self->{RESOURCE},")\n";
354    print "JID:      (",$self->{JID},")\n";
355}
356
357
3581;
Note: See TracBrowser for help on using the repository browser.