[0ff8d110] | 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 | |
---|
| 23 | package Net::Jabber::XDB; |
---|
| 24 | |
---|
| 25 | =head1 NAME |
---|
| 26 | |
---|
| 27 | Net::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 | |
---|
[cb54527] | 46 | my $xdb = Net::Jabber::XDB->new(@tree); |
---|
[0ff8d110] | 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 | |
---|
[cb54527] | 67 | $XDB = Net::Jabber::XDB->new(); |
---|
[0ff8d110] | 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 | |
---|
| 253 | By Ryan Eatmon in May of 2001 for http://jabber.org.. |
---|
| 254 | |
---|
| 255 | =head1 COPYRIGHT |
---|
| 256 | |
---|
| 257 | This module is free software; you can redistribute it and/or modify |
---|
| 258 | it under the same terms as Perl itself. |
---|
| 259 | |
---|
| 260 | =cut |
---|
| 261 | |
---|
| 262 | require 5.003; |
---|
| 263 | use strict; |
---|
| 264 | use Carp; |
---|
| 265 | use vars qw($VERSION $AUTOLOAD %FUNCTIONS); |
---|
| 266 | |
---|
| 267 | $VERSION = "2.0"; |
---|
| 268 | |
---|
| 269 | sub 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 | ############################################################################## |
---|
| 312 | sub 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 | ############################################################################## |
---|
| 400 | sub 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 | ############################################################################## |
---|
| 414 | sub Reply |
---|
| 415 | { |
---|
| 416 | my $self = shift; |
---|
| 417 | my %args; |
---|
| 418 | while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); } |
---|
| 419 | |
---|
[cb54527] | 420 | my $reply = Net::Jabber::XDB->new(); |
---|
[0ff8d110] | 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 | |
---|
| 441 | 1; |
---|