source: perl/lib/Net/Jabber/XDB.pm @ 31cf416

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 31cf416 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: 13.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#  Jabber
19#  Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
20#
21##############################################################################
22
23package Net::Jabber::XDB;
24
25=head1 NAME
26
27Net::Jabber::XDB - Jabber XDB Library
28
29=head1 SYNOPSIS
30
31  Net::Jabber::XDB is a companion to the Net::Jabber module. It
32  provides the user a simple interface to set and retrieve all
33  parts of a Jabber XDB.
34
35=head1 DESCRIPTION
36
37  Net::Jabber::XDB differs from the other Net::Jabber::* modules in that
38  the XMLNS of the data is split out into more submodules under
39  XDB.  For specifics on each module please view the documentation
40  for each Net::Jabber::Data::* module.  To see the list of avilable
41  namspaces and modules see Net::Jabber::Data.
42
43  To initialize the XDB with a Jabber <xdb/> you must pass it the
44  XML::Parser Tree array.  For example:
45
46    my $xdb = new Net::Jabber::XDB(@tree);
47
48  There has been a change from the old way of handling the callbacks.
49  You no longer have to do the above, a Net::Jabber::XDB object is passed
50  to the callback function for the xdb:
51
52    use Net::Jabber qw(Component);
53
54    sub xdb {
55      my ($XDB) = @_;
56      .
57      .
58      .
59    }
60
61  You now have access to all of the retrieval functions available.
62
63  To create a new xdb to send to the server:
64
65    use Net::Jabber;
66
67    $XDB = new Net::Jabber::XDB();
68    $XDBType = $XDB->NewData( type );
69    $XDBType->SetXXXXX("yyyyy");
70
71  Now you can call the creation functions for the XDB, and for the <data/>
72  on the new Data object itself.  See below for the <xdb/> functions, and
73  in each data module for those functions.
74
75  For more information about the array format being passed to the CallBack
76  please read the Net::Jabber::Client documentation.
77
78=head1 METHODS
79
80=head2 Retrieval functions
81
82  GetTo()      - returns either a string with the Jabber Identifier,
83  GetTo("jid")   or a Net::Jabber::JID object for the person who is
84                 going to receive the <xdb/>.  To get the JID
85                 object set the string to "jid", otherwise leave
86                 blank for the text string.
87
88                 $to    = $XDB->GetTo();
89                 $toJID = $XDB->GetTo("jid");
90
91  GetFrom()      -  returns either a string with the Jabber Identifier,
92  GetFrom("jid")    or a Net::Jabber::JID object for the person who
93                    sent the <xdb/>.  To get the JID object set
94                    the string to "jid", otherwise leave blank for the
95                    text string.
96
97                    $from    = $XDB->GetFrom();
98                    $fromJID = $XDB->GetFrom("jid");
99
100  GetType() - returns a string with the type <xdb/> this is.
101
102              $type = $XDB->GetType();
103
104  GetID() - returns an integer with the id of the <xdb/>.
105
106            $id = $XDB->GetID();
107
108  GetAction() - returns a string with the action <xdb/> this is.
109
110              $action = $XDB->GetAction();
111
112  GetMatch() - returns a string with the match <xdb/> this is.
113
114              $match = $XDB->GetMatch();
115
116  GetError() - returns a string with the text description of the error.
117
118               $error = $XDB->GetError();
119
120  GetErrorCode() - returns a string with the code of error.
121
122                   $errorCode = $XDB->GetErrorCode();
123
124  GetData() - returns a Net::Jabber::Data object that contains the data
125              in the <data/> of the <xdb/>.
126
127              $dataTag = $XDB->GetData();
128
129  GetDataXMLNS() - returns a string with the namespace of the data
130                   for this <xdb/>, if one exists.
131
132                   $xmlns = $XDB->GetDataXMLNS();
133
134=head2 Creation functions
135
136  SetXDB(to=>string|JID,    - set multiple fields in the <xdb/> at one
137        from=>string|JID,     time.  This is a cumulative and over
138        id=>string,           writing action.  If you set the "to"
139        type=>string,         attribute twice, the second setting is
140        action=>string,       what is used.  If you set the status, and
141        match=>string)        then set the priority then both will be in
142        errorcode=>string,    the <xdb/> tag.  For valid settings read the
143        error=>string)        specific Set functions below.
144
145                              $XDB->SetXDB(type=>"get",
146                                           to=>"bob\@jabber.org",
147                                           data=>"info");
148
149                              $XDB->SetXDB(to=>"bob\@jabber.org",
150                                           errorcode=>403,
151                                           error=>"Permission Denied");
152
153  SetTo(string) - sets the to attribute.  You can either pass a string
154  SetTo(JID)      or a JID object.  They must be a valid Jabber
155                  Identifiers or the server will return an error message.
156                  (ie.  jabber:bob@jabber.org, etc...)
157
158                 $XDB->SetTo("bob\@jabber.org");
159
160  SetFrom(string) - sets the from attribute.  You can either pass a string
161  SetFrom(JID)      or a JID object.  They must be a valid Jabber
162                    Identifiers or the server will return an error message.
163                    (ie.  jabber:bob@jabber.org, etc...)
164
165                    $XDB->SetFrom("me\@jabber.org");
166
167  SetType(string) - sets the type attribute.  Valid settings are:
168
169                    get      request information
170                    set      set information
171                    result   results of a get
172                    error    there was an error
173
174                    $XDB->SetType("set");
175
176  SetAction(string) - sets the error code of the <xdb/>.
177
178                      $XDB->SetAction("foo");
179
180  SetMatch(string) - sets the error code of the <xdb/>.
181
182                     $XDB->SetMatch("foo");
183
184  SetErrorCode(string) - sets the error code of the <xdb/>.
185
186                         $XDB->SetErrorCode(403);
187
188  SetError(string) - sets the error string of the <xdb/>.
189
190                     $XDB->SetError("Permission Denied");
191
192  NewData(string) - creates a new Net::Jabber::Data object with the
193                     namespace in the string.  In order for this function
194                     to work with a custom namespace, you must define and
195                     register that namespace with the XDB module.  For more
196                     information please read the documentation for
197                     Net::Jabber::Data.
198
199                     $dataObj = $XDB->NewData("jabber:xdb:auth");
200                     $dataObj = $XDB->NewData("jabber:xdb:roster");
201
202  Reply(hash) - creates a new XDB object and populates the to/from
203                fields.  If you specify a hash the same as with SetXDB
204                then those values will override the Reply values.
205
206                $xdbReply = $XDB->Reply();
207                $xdbReply = $XDB->Reply(type=>"result");
208
209=head2 Test functions
210
211  DefinedTo() - returns 1 if the to attribute is defined in the <xdb/>,
212                0 otherwise.
213
214                $test = $XDB->DefinedTo();
215
216  DefinedFrom() - returns 1 if the from attribute is defined in the <xdb/>,
217                  0 otherwise.
218
219                  $test = $XDB->DefinedFrom();
220
221  DefinedID() - returns 1 if the id attribute is defined in the <xdb/>,
222                0 otherwise.
223
224                $test = $XDB->DefinedID();
225
226  DefinedType() - returns 1 if the type attribute is defined in the <xdb/>,
227                  0 otherwise.
228
229                  $test = $XDB->DefinedType();
230
231  DefinedAction() - returns 1 if the action attribute is defined in the <xdb/>,
232                   0 otherwise.
233
234                   $test = $XDB->DefinedAction();
235
236  DefinedMatch() - returns 1 if the match attribute is defined in the <xdb/>,
237                   0 otherwise.
238
239                   $test = $XDB->DefinedMatch();
240
241  DefinedError() - returns 1 if <error/> is defined in the <xdb/>,
242                   0 otherwise.
243
244                   $test = $XDB->DefinedError();
245
246  DefinedErrorCode() - returns 1 if the code attribute is defined in
247                       <error/>, 0 otherwise.
248
249                       $test = $XDB->DefinedErrorCode();
250
251=head1 AUTHOR
252
253By Ryan Eatmon in May of 2001 for http://jabber.org..
254
255=head1 COPYRIGHT
256
257This module is free software; you can redistribute it and/or modify
258it under the same terms as Perl itself.
259
260=cut
261
262require 5.003;
263use strict;
264use Carp;
265use vars qw($VERSION $AUTOLOAD %FUNCTIONS);
266
267$VERSION = "2.0";
268
269sub new
270{
271    my $proto = shift;
272    my $class = ref($proto) || $proto;
273    my $self = { };
274
275    $self->{VERSION} = $VERSION;
276
277    bless($self, $proto);
278
279    $self->{DEBUGHEADER} = "XDB";
280
281    $self->{DATA} = {};
282    $self->{CHILDREN} = {};
283
284    $self->{TAG} = "xdb";
285
286    if ("@_" ne (""))
287    {
288        if (ref($_[0]) eq "Net::Jabber::XDB")
289        {
290            return $_[0];
291        }
292        else
293        {
294            $self->{TREE} = shift;
295            $self->ParseTree();
296        }
297    }
298    else
299    {
300        $self->{TREE} = new XML::Stream::Node($self->{TAG});
301    }
302
303    return $self;
304}
305
306
307##############################################################################
308#
309# AUTOLOAD - This function calls the main AutoLoad function in Jabber.pm
310#
311##############################################################################
312sub AUTOLOAD
313{
314    my $self = shift;
315    &Net::Jabber::AutoLoad($self,$AUTOLOAD,@_);
316}
317
318$FUNCTIONS{Action}->{Get}           = "action";
319$FUNCTIONS{Action}->{Set}           = ["scalar","action"];
320$FUNCTIONS{Action}->{Defined}       = "action";
321$FUNCTIONS{Action}->{Hash}          = "att";
322$FUNCTIONS{Action}->{XPath}->{Type} = 'scalar';
323$FUNCTIONS{Action}->{XPath}->{Path} = '@action';
324
325$FUNCTIONS{Error}->{Get}           = "error";
326$FUNCTIONS{Error}->{Set}           = ["scalar","error"];
327$FUNCTIONS{Error}->{Defined}       = "error";
328$FUNCTIONS{Error}->{Hash}          = "child-data";
329$FUNCTIONS{Error}->{XPath}->{Type} = 'scalar';
330$FUNCTIONS{Error}->{XPath}->{Path} = 'error/text()';
331
332$FUNCTIONS{ErrorCode}->{Get}           = "errorcode";
333$FUNCTIONS{ErrorCode}->{Set}           = ["scalar","errorcode"];
334$FUNCTIONS{ErrorCode}->{Defined}       = "errorcode";
335$FUNCTIONS{ErrorCode}->{Hash}          = "att-error-code";
336$FUNCTIONS{ErrorCode}->{XPath}->{Type} = 'scalar';
337$FUNCTIONS{ErrorCode}->{XPath}->{Path} = 'error/@code';
338
339$FUNCTIONS{From}->{Get}           = "from";
340$FUNCTIONS{From}->{Set}           = ["jid","from"];
341$FUNCTIONS{From}->{Defined}       = "from";
342$FUNCTIONS{From}->{Hash}          = "att";
343$FUNCTIONS{From}->{XPath}->{Type} = 'jid';
344$FUNCTIONS{From}->{XPath}->{Path} = '@from';
345
346$FUNCTIONS{Match}->{Get}           = "match";
347$FUNCTIONS{Match}->{Set}           = ["scalar","match"];
348$FUNCTIONS{Match}->{Defined}       = "match";
349$FUNCTIONS{Match}->{Hash}          = "att";
350$FUNCTIONS{Match}->{XPath}->{Type} = 'scalar';
351$FUNCTIONS{Match}->{XPath}->{Path} = '@match';
352
353$FUNCTIONS{NS}->{Get}           = "ns";
354$FUNCTIONS{NS}->{Set}           = ["scalar","ns"];
355$FUNCTIONS{NS}->{Defined}       = "ns";
356$FUNCTIONS{NS}->{Hash}          = "att";
357$FUNCTIONS{NS}->{XPath}->{Type} = 'scalar';
358$FUNCTIONS{NS}->{XPath}->{Path} = '@ns';
359
360$FUNCTIONS{ID}->{Get}           = "id";
361$FUNCTIONS{ID}->{Set}           = ["scalar","id"];
362$FUNCTIONS{ID}->{Defined}       = "id";
363$FUNCTIONS{ID}->{Hash}          = "att";
364$FUNCTIONS{ID}->{XPath}->{Type} = 'scalar';
365$FUNCTIONS{ID}->{XPath}->{Path} = '@id';
366
367$FUNCTIONS{To}->{Get}           = "to";
368$FUNCTIONS{To}->{Set}           = ["jid","to"];
369$FUNCTIONS{To}->{Defined}       = "to";
370$FUNCTIONS{To}->{Hash}          = "att";
371$FUNCTIONS{To}->{XPath}->{Type} = 'jid';
372$FUNCTIONS{To}->{XPath}->{Path} = '@to';
373
374$FUNCTIONS{Type}->{Get}           = "type";
375$FUNCTIONS{Type}->{Set}           = ["scalar","type"];
376$FUNCTIONS{Type}->{Defined}       = "type";
377$FUNCTIONS{Type}->{Hash}          = "att";
378$FUNCTIONS{Type}->{XPath}->{Type} = 'scalar';
379$FUNCTIONS{Type}->{XPath}->{Path} = '@type';
380
381$FUNCTIONS{Data}->{Get}           = "__netjabber__:children:data";
382$FUNCTIONS{Data}->{Defined}       = "__netjabber__:children:data";
383$FUNCTIONS{Data}->{XPath}->{Type} = 'node';
384$FUNCTIONS{Data}->{XPath}->{Path} = '*[@xmlns]';
385
386$FUNCTIONS{X}->{Get}           = "__netjabber__:children:x";
387$FUNCTIONS{X}->{Defined}       = "__netjabber__:children:x";
388$FUNCTIONS{X}->{XPath}->{Type} = 'node';
389$FUNCTIONS{X}->{XPath}->{Path} = '*[@xmlns]';
390
391$FUNCTIONS{XDB}->{Get} = "__netjabber__:master";
392$FUNCTIONS{XDB}->{Set} = ["master"];
393
394
395##############################################################################
396#
397# GetDataXMLNS - returns the xmlns of the <data/> tag
398#
399##############################################################################
400sub GetDataXMLNS
401{
402    my $self = shift;
403    #XXX fix this
404    return $self->{CHILDREN}->{data}->[0]->GetXMLNS() if exists($self->{CHILDREN}->{data});
405}
406
407
408##############################################################################
409#
410# Reply - returns a Net::Jabber::XDB object with the proper fields
411#         already populated for you.
412#
413##############################################################################
414sub Reply
415{
416    my $self = shift;
417    my %args;
418    while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
419
420    my $reply = new Net::Jabber::XDB();
421
422    $reply->SetID($self->GetID()) if ($self->GetID() ne "");
423    $reply->SetType("result");
424
425    if ($self->DefinedData())
426    {
427        my $selfData = $self->GetData();
428        $reply->NewData($selfData->GetXMLNS());
429    }
430
431    $reply->SetXDB(to=>$self->GetFrom(),
432                   from=>$self->GetTo()
433                  );
434
435    $reply->SetXDB(%args);
436
437    return $reply;
438}
439
440
4411;
Note: See TracBrowser for help on using the repository browser.