Net-Jabber-2.0/ 0002755 0001750 0001750 00000000000 10112242737 014421 5 ustar reatmon reatmon 0000000 0000000 Net-Jabber-2.0/lib/ 0002755 0001750 0001750 00000000000 10112242736 015166 5 ustar reatmon reatmon 0000000 0000000 Net-Jabber-2.0/lib/Net/ 0002755 0001750 0001750 00000000000 10112242736 015714 5 ustar reatmon reatmon 0000000 0000000 Net-Jabber-2.0/lib/Net/Jabber.pm 0000644 0001750 0001750 00000013550 10110275751 017442 0 ustar reatmon reatmon 0000000 0000000 ###############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
###############################################################################
package Net::Jabber;
=head1 NAME
Net::Jabber - Jabber Perl Library
=head1 SYNOPSIS
Net::Jabber provides a Perl user with access to the Jabber Instant
Messaging protocol.
For more information about Jabber visit:
http://www.jabber.org
=head1 DESCRIPTION
Net::Jabber is a convenient tool to use for any perl script that would
like to utilize the Jabber Instant Messaging protocol. While not a
client in and of itself, it provides all of the necessary back-end
functions to make a CGI client or command-line perl client feasible and
easy to use. Net::Jabber is a wrapper around the rest of the official
Net::Jabber::xxxxxx packages.
There is are example scripts in the example directory that provide you
with examples of very simple Jabber programs.
NOTE: The parser that XML::Stream::Parser provides, as are most Perl
parsers, is synchronous. If you are in the middle of parsing a packet
and call a user defined callback, the Parser is blocked until your
callback finishes. This means you cannot be operating on a packet,
send out another packet and wait for a response to that packet. It
will never get to you. Threading might solve this, but as of the
writing of this, threading in Perl is not quite up to par yet. This
issue will be revisted in the future.
=head1 EXAMPLES
For a client:
use Net::Jabber;
my $client = new Net::Jabber::Client();
For a component:
use Net::Jabber;
my $component = new Net::Jabber::Component();
=head1 METHODS
The Net::Jabber module does not define any methods that you will call
directly in your code. Instead you will instantiate objects that call
functions from this module to do work. The three main objects that
you will work with are the Message, Presence, and IQ modules. Each one
corresponds to the Jabber equivilant and allows you get and set all
parts of those packets.
=head1 PACKAGES
For more information on each of these packages, please see the man page
for each one.
=head2 Net::Jabber::Client
This package contains the code needed to communicate with a Jabber
server: login, wait for messages, send messages, and logout. It uses
XML::Stream to read the stream from the server and based on what kind
of tag it encounters it calls a function to handle the tag.
=head2 Net::Jabber::Component
This package contains the code needed to write a server component. A
component is a program tha handles the communication between a jabber
server and some outside program or communications pacakge (IRC, talk,
email, etc...) With this module you can write a full component in just
a few lines of Perl. It uses XML::Stream to communicate with its host
server and based on what kind of tag it encounters it calls a function
to handle the tag.
=head2 Net::Jabber::Protocol
A collection of high-level functions that Client and Component use to
make their lives easier through inheritance.
=head2 Net::Jabber::JID
The Jabber IDs consist of three parts: user id, server, and resource.
This module gives you access to those components without having to
parse the string yourself.
=head2 Net::Jabber::Message
Everything needed to create and read a received from the
server.
=head2 Net::Jabber::Presence
Everything needed to create and read a received from the
server.
=head2 Net::Jabber::IQ
IQ is a wrapper around a number of modules that provide support for the
various Info/Query namespaces that Jabber recognizes.
=head2 Net::Jabber::Stanza
This module represents a namespaced stanza that is used to extend a
, , and . Ultimately each namespace is
documented in a JEP of some kind. http://jabber.org/jeps/
The man page for Net::Jabber::Stanza contains a listing of all
supported namespaces, and the methods that are supported by the objects
that represent those namespaces.
=head2 Net::Jabber::Namespaces
Jabber allows for any stanza to be extended by any bit of XML. This
module contains all of the internals for defining the Jabber based
extensions defined by the JEPs. The documentation for this module
explains more about how to add your own custom namespace and have it be
supported.
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.005;
use strict;
use Carp;
use POSIX;
use Net::XMPP 1.0;
use base qw( Net::XMPP );
use vars qw( $VERSION );
$VERSION = "2.0";
use Net::Jabber::Debug;
use Net::Jabber::JID;
use Net::Jabber::Namespaces;
use Net::Jabber::Stanza;
use Net::Jabber::Message;
use Net::Jabber::IQ;
use Net::Jabber::Presence;
use Net::Jabber::Protocol;
use Net::Jabber::Client;
use Net::Jabber::Component;
sub GetTimeStamp { return &Net::XMPP::GetTimeStamp(@_); }
sub printData { return &Net::XMPP::printData(@_); }
sub sprintData { return &Net::XMPP::sprintData(@_); }
1;
Net-Jabber-2.0/lib/Net/Jabber/ 0002755 0001750 0001750 00000000000 10112242737 017102 5 ustar reatmon reatmon 0000000 0000000 Net-Jabber-2.0/lib/Net/Jabber/Protocol.pm 0000644 0001750 0001750 00000312253 10110304740 021234 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::Protocol;
=head1 NAME
Net::Jabber::Protocol - Jabber Protocol Library
=head1 SYNOPSIS
Net::Jabber::Protocol is a module that provides a developer easy
access to the Jabber Instant Messaging protocol. It provides high
level functions to the Net::Jabber Client, Component, and Server
objects. These functions are automatically indluded in those modules
through AUTOLOAD and delegates.
=head1 DESCRIPTION
Protocol.pm seeks to provide enough high level APIs and automation of
the low level APIs that writing a Jabber Client/Transport in Perl is
trivial. For those that wish to work with the low level you can do
that too, but those functions are covered in the documentation for
each module.
Net::Jabber::Protocol provides functions to login, send and receive
messages, set personal information, create a new user account, manage
the roster, and disconnect. You can use all or none of the functions,
there is no requirement.
For more information on how the details for how Net::Jabber is written
please see the help for Net::Jabber itself.
For more information on writing a Client see Net::Jabber::Client.
For more information on writing a Transport see Net::Jabber::Transport.
=head2 Modes
Several of the functions take a mode argument that let you specify how
the function should behave:
block - send the packet with an ID, and then block until an answer
comes back. You can optionally specify a timeout so that
you do not block forever.
nonblock - send the packet with an ID, but then return that id and
control to the master program. Net::Jabber is still
tracking this packet, so you must use the CheckID function
to tell when it comes in. (This might not be very
useful...)
passthru - send the packet with an ID, but do NOT register it with
Net::Jabber, then return the ID. This is useful when
combined with the XPath function because you can register
a one shot function tied to the id you get back.
=head2 Basic Functions
use Net::Jabber qw( Client );
$Con = new Net::Jabber::Client(); # From
$status = $Con->Connect(hostname=>"jabber.org"); # Net::Jabber::Client
or
use Net::Jabber qw( Component );
$Con = new Net::Jabber::Component(); #
$status = $Con->Connect(hostname=>"jabber.org", # From
secret=>"bob"); # Net::Jabber::Component
#
# For callback setup, see Net::XMPP::Protocol
#
$Con->Info(name=>"Jarl",
version=>"v0.6000");
=head2 ID Functions
$id = $Con->SendWithID($sendObj);
$id = $Con->SendWithID("XML");
$receiveObj = $Con->SendAndReceiveWithID($sendObj);
$receiveObj = $Con->SendAndReceiveWithID($sendObj,
10);
$receiveObj = $Con->SendAndReceiveWithID("XML");
$receiveObj = $Con->SendAndReceiveWithID("XML",
5);
$yesno = $Con->ReceivedID($id);
$receiveObj = $Con->GetID($id);
$receiveObj = $Con->WaitForID($id);
$receiveObj = $Con->WaitForID($id,
20);
=head2 IQ Functions
=head2 Agents Functions
%agents = $Con->AgentsGet();
%agents = $Con->AgentsGet(to=>"transport.jabber.org");
=head2 Browse Functions
%hash = $Con->BrowseRequest(jid=>"jabber.org");
%hash = $Con->BrowseRequest(jid=>"jabber.org",
timeout=>10);
$id = $Con->BrowseRequest(jid=>"jabber.org",
mode=>"nonblock");
$id = $Con->BrowseRequest(jid=>"jabber.org",
mode=>"passthru");
=head2 Browse DB Functions
$Con->BrowseDBDelete("jabber.org");
$Con->BrowseDBDelete(Net::Jabber::JID);
$presence = $Con->BrowseDBQuery(jid=>"bob\@jabber.org");
$presence = $Con->BrowseDBQuery(jid=>Net::Jabber::JID);
$presence = $Con->BrowseDBQuery(jid=>"users.jabber.org",
timeout=>10);
$presence = $Con->BrowseDBQuery(jid=>"conference.jabber.org",
refresh=>1);
=head2 Bystreams Functions
%hash = $Con->ByteStreamsProxyRequest(jid=>"proxy.server");
%hash = $Con->ByteStreamsProxyRequest(jid=>"proxy.server",
timeout=>10);
$id = $Con->ByteStreamsProxyRequest(jid=>"proxy.server",
mode=>"nonblock");
$id = $Con->ByteStreamsProxyRequest(jid=>"proxy.server",
mode=>"passthru");
%hash = $Con->ByteStreamsProxyParse($query);
$status = $Con->ByteStreamsProxyActivate(sid=>"stream_id",
jid=>"proxy.server");
$status = $Con->ByteStreamsProxyActivate(sid=>"stream_id",
jid=>"proxy.server",
timeout=>10);
$id = $Con->ByteStreamsProxyActivate(sid=>"stream_id",
jid=>"proxy.server",
mode=>"nonblock");
$id = $Con->ByteStreamsProxyActivate(sid=>"stream_id",
jid=>"proxy.server",
mode=>"passthru");
$jid = $Con->ByteStreamsOffer(sid=>"stream_id",
streamhosts=>[{jid=>"jid",
host=>"host",
port=>"port",
zeroconf=>"zero",
},
...
],
jid=>"bob\@jabber.org");
$jid = $Con->ByteStreamsOffer(sid=>"stream_id",
streamhosts=>[{},{},...],
jid=>"bob\@jabber.org",
timeout=>10);
$id = $Con->ByteStreamsOffer(sid=>"stream_id",
streamhosts=>[{},{},...],
jid=>"bob\@jabber.org",
mode=>"nonblock");
$id = $Con->ByteStreamsOffer(sid=>"stream_id",
streamhosts=>[{},{},...],
jid=>"bob\@jabber.org",
mode=>"passthru");
=head2 Disco Functions
%hash = $Con->DiscoInfoRequest(jid=>"jabber.org");
%hash = $Con->DiscoInfoRequest(jid=>"jabber.org",
node=>"node...");
%hash = $Con->DiscoInfoRequest(jid=>"jabber.org",
node=>"node...",
timeout=>10);
$id = $Con->DiscoInfoRequest(jid=>"jabber.org",
mode=>"nonblock");
$id = $Con->DiscoInfoRequest(jid=>"jabber.org",
node=>"node...",
mode=>"nonblock");
$id = $Con->DiscoInfoRequest(jid=>"jabber.org",
mode=>"passthru");
$id = $Con->DiscoInfoRequest(jid=>"jabber.org",
node=>"node...",
mode=>"passthru");
%hash = $Con->DiscoInfoParse($query);
%hash = $Con->DiscoItemsRequest(jid=>"jabber.org");
%hash = $Con->DiscoItemsRequest(jid=>"jabber.org",
timeout=>10);
$id = $Con->DiscoItemsRequest(jid=>"jabber.org",
mode=>"nonblock");
$id = $Con->DiscoItemsRequest(jid=>"jabber.org",
mode=>"passthru");
%hash = $Con->DiscoItemsParse($query);
=head2 Feature Negotiation Functions
%hash = $Con->FeatureNegRequest(jid=>"jabber.org",
features=>{ feat1=>["opt1","opt2",...],
feat2=>["optA","optB",...]
}
);
%hash = $Con->FeatureNegRequest(jid=>"jabber.org",
features=>{ ... },
timeout=>10);
$id = $Con->FeatureNegRequest(jid=>"jabber.org",
features=>{ ... },
mode=>"nonblock");
$id = $Con->FeatureNegRequest(jid=>"jabber.org",
features=>{ ... },
mode=>"passthru");
my $query = $self->FeatureNegQuery(\{ ... });
$iq->AddQuery($query);
%hash = $Con->FeatureNegParse($query);
=head2 File Transfer Functions
$method = $Con->FileTransferOffer(jid=>"bob\@jabber.org",
sid=>"stream_id",
filename=>"/path/to/file",
methods=>["http://jabber.org/protocol/si/profile/bytestreams",
"jabber:iq:oob",
...
]
);
$method = $Con->FileTransferOffer(jid=>"bob\@jabber.org",
sid=>"stream_id",
filename=>"/path/to/file",
methods=>\@methods,
timeout=>"10");
$id = $Con->FileTransferOffer(jid=>"bob\@jabber.org",
sid=>"stream_id",
filename=>"/path/to/file",
methods=>\@methods,
mode=>"nonblock");
$id = $Con->FileTransferOffer(jid=>"bob\@jabber.org",
sid=>"stream_id",
filename=>"/path/to/file",
methods=>\@methods,
mode=>"passthru");
=head2 Last Functions
$Con->LastQuery();
$Con->LastQuery(to=>"bob@jabber.org");
%result = $Con->LastQuery(mode=>"block");
%result = $Con->LastQuery(to=>"bob@jabber.org",
mode=>"block");
%result = $Con->LastQuery(to=>"bob@jabber.org",
mode=>"block",
timeout=>10);
%result = $Con->LastQuery(mode=>"block",
timeout=>10);
$Con->LastSend(to=>"bob@jabber.org");
$seconds = $Con->LastActivity();
=head2 Multi-User Chat Functions
$Con->MUCJoin(room=>"jabber",
server=>"conference.jabber.org",
nick=>"nick");
$Con->MUCJoin(room=>"jabber",
server=>"conference.jabber.org",
nick=>"nick",
password=>"secret");
=head2 Register Functions
@result = $Con->RegisterSendData("users.jabber.org",
first=>"Bob",
last=>"Smith",
nick=>"bob",
email=>"foo@bar.net");
=head2 RPC Functions
$query = $Con->RPCEncode(type=>"methodCall",
methodName=>"methodName",
params=>[param,param,...]);
$query = $Con->RPCEncode(type=>"methodResponse",
params=>[param,param,...]);
$query = $Con->RPCEncode(type=>"methodResponse",
faultCode=>4,
faultString=>"Too many params");
@response = $Con->RPCParse($iq);
@response = $Con->RPCCall(to=>"dataHouse.jabber.org",
methodname=>"numUsers",
params=>[ param,param,... ]
);
$Con->RPCResponse(to=>"you\@jabber.org",
params=>[ param,param,... ]);
$Con->RPCResponse(to=>"you\@jabber.org",
faultCode=>"4",
faultString=>"Too many parameters"
);
$Con->RPCSetCallBacks(myMethodA=>\&methoda,
myMethodB=>\&do_somthing,
etc...
);
=head2 Search Functions
%fields = $Con->SearchRequest();
%fields = $Con->SearchRequest(to=>"users.jabber.org");
%fields = $Con->SearchRequest(to=>"users.jabber.org",
timeout=>10);
$Con->SearchSend(to=>"somewhere",
name=>"",
first=>"Bob",
last=>"",
nick=>"bob",
email=>"",
key=>"some key");
$Con->SearchSendData("users.jabber.org",
first=>"Bob",
last=>"",
nick=>"bob",
email=>"");
=head2 Time Functions
$Con->TimeQuery();
$Con->TimeQuery(to=>"bob@jabber.org");
%result = $Con->TimeQuery(mode=>"block");
%result = $Con->TimeQuery(to=>"bob@jabber.org",
mode=>"block");
$Con->TimeSend(to=>"bob@jabber.org");
=head2 Version Functions
$Con->VersionQuery();
$Con->VersionQuery(to=>"bob@jabber.org");
%result = $Con->VersionQuery(mode=>"block");
%result = $Con->VersionQuery(to=>"bob@jabber.org",
mode=>"block");
$Con->VersionSend(to=>"bob@jabber.org",
name=>"Net::Jabber",
ver=>"1.0a",
os=>"Perl");
=head1 METHODS
=head2 Basic Functions
Info(name=>string, - Set some information so that Net::Jabber
version=>string) can auto-reply to some packets for you to
reduce the work you have to do.
NOTE: This requires that you use the
SetIQCallBacks methodology and not the
SetCallBacks for packets.
=head2 IQ Functions
=head2 Agents Functions
********************************
* *
* Deprecated in favor of Disco *
* *
********************************
AgentsGet(to=>string, - takes all of the information and
AgentsGet() builds a Net::Jabber::IQ::Agents packet.
It then sends that packet either to the
server, or to the specified transport,
with an ID and waits for that ID to return.
Then it looks in the resulting packet and
builds a hash that contains the values
of the agent list. The hash is layed out
like this: (NOTE: the jid is the key to
distinguish the various agents)
$hash{}->{order} = 4
->{name} = "ICQ Transport"
->{transport} = "ICQ #"
->{description} = "ICQ..blah.."
->{service} = "icq"
->{register} = 1
->{search} = 1
etc...
The order field determines the order that
it came from the server in... in case you
care. For more info on the valid fields
see the Net::Jabber::Query jabber:iq:agent
namespace.
=head2 Browse Functions
********************************
* *
* Deprecated in favor of Disco *
* *
********************************
BrowseRequest(jid=>string, - sends a jabber:iq:browse request to
mode=>string, the jid passed as an argument.
timeout=>int) Returns a hash with the resulting
tree if mode is set to "block":
$browse{'category'} = "conference"
$browse{'children'}->[0]
$browse{'children'}->[1]
$browse{'children'}->[11]
$browse{'jid'} = "conference.jabber.org"
$browse{'name'} = "Jabber.org Conferencing Center"
$browse{'ns'}->[0]
$browse{'ns'}->[1]
$browse{'type'} = "public"
The ns array is an array of the
namespaces that this jid supports.
The children array points to hashs
of this form, and represent the fact
that they can be browsed to.
See MODES above for using the mode
and timeout.
=head2 Browse DB Functions
BrowseDBDelete(string|Net::Jabber::JID) - delete thes JID browse
data from the DB.
BrowseDBQuery(jid=>string | NJ::JID, - returns the browse data
timeout=>integer, for the requested JID. If
refresh=>0|1) the DB does not contain
the data for the JID, then
it attempts to fetch the
data via BrowseRequest().
The timeout is passed to
the BrowseRequest() call,
and refresh tells the DB
to request the data, even
if it already has some.
=head2 Bytestreams Functions
ByteStreamsProxyRequest(jid=>string, - sends a bytestreams request
mode=>string, to the jid passed as an
timeout=>int) argument. Returns an array
ref with the resulting tree
if mode is set to "block".
See ByteStreamsProxyParse
for the format of the
resulting tree.
See MODES above for using
the mode and timeout.
ByteStreamsProxyParse(Net::Jabber::Query) - parses the query and
returns an array ref
to the resulting tree:
$host[0]->{jid} = "bytestreams1.proxy.server";
$host[0]->{host} = "proxy1.server";
$host[0]->{port} = "5006";
$host[1]->{jid} = "bytestreams2.proxy.server";
$host[1]->{host} = "proxy2.server";
$host[1]->{port} = "5007";
...
ByteStreamsProxyActivate(jid=>string, - sends a bytestreams activate
sid=>string, to the jid passed as an
mode=>string, argument. Returns 1 if the
timeout=>int) proxy activated (undef if
it did not) if mode is set
to "block".
sid is the stream id that
is being used to talk about
this stream.
See MODES above for using
the mode and timeout.
ByteStreamsOffer(jid=>string, - sends a bytestreams offer
sid=>string, to the jid passed as an
streamhosts=>arrayref argument. Returns the jid
mode=>string, of the streamhost that the
timeout=>int) user selected if mode is set
to "block".
streamhosts is the same
format as the array ref
returned from
ByteStreamsProxyParse.
See MODES above for using
the mode and timeout.
=head2 Disco Functions
DiscoInfoRequest(jid=>string, - sends a disco#info request to
node=>string, the jid passed as an argument,
mode=>string, and the node if specified.
timeout=>int) Returns a hash with the resulting
tree if mode is set to "block".
See DiscoInfoParse for the format
of the resulting tree.
See MODES above for using the mode
and timeout.
DiscoInfoParse(Net::Jabber::Query) - parses the query and
returns a hash ref
to the resulting tree:
$info{identity}->[0]->{category} = "groupchat";
$info{identity}->[0]->{name} = "Public Chatrooms";
$info{identity}->[0]->{type} = "public";
$info{identity}->[1]->{category} = "groupchat";
$info{identity}->[1]->{name} = "Private Chatrooms";
$info{identity}->[1]->{type} = "private";
$info{feature}->{http://jabber.org/protocol/disco#info} = 1;
$info{feature}->{http://jabber.org/protocol/muc#admin} = 1;
DiscoItemsRequest(jid=>string, - sends a disco#items request to
mode=>string, the jid passed as an argument.
timeout=>int) Returns a hash with the resulting
tree if mode is set to "block".
See DiscoItemsParse for the format
of the resulting tree.
See MODES above for using the mode
and timeout.
DiscoItemsParse(Net::Jabber::Query) - parses the query and
returns a hash ref
to the resulting tree:
$items{jid}->{node} = name;
$items{"proxy.server"}->{""} = "Bytestream Proxy Server";
$items{"conf.server"}->{"public"} = "Public Chatrooms";
$items{"conf.server"}->{"private"} = "Private Chatrooms";
=head2 Feature Negotiation Functions
FeatureNegRequest(jid=>string, - sends a feature negotiation to
features=>hash ref, the jid passed as an argument,
mode=>string, using the features specified.
timeout=>int) Returns a hash with the resulting
tree if mode is set to "block".
See DiscoInfoQuery for the format
of the features hash ref.
See DiscoInfoParse for the format
of the resulting tree.
See MODES above for using the mode
and timeout.
FeatureNegParse(Net::Jabber::Query) - parses the query and
returns a hash ref
to the resulting tree:
$features->{feat1} = ["opt1","opt2",...];
$features->{feat2} = ["optA","optB",...];
....
If this is a result:
$features->{feat1} = "opt2";
$features->{feat2} = "optA";
....
FeatureNeqQuery(hash ref) - takes a hash ref and turns it into a
feature negotiation query that you can
AddQuery into your packaet. The format
of the hash ref is as follows:
$features->{feat1} = ["opt1","opt2",...];
$features->{feat2} = ["optA","optB",...];
....
=head2 File Transfer Functions
FileTransferOffer(jid=>string, - sends a file transfer stream
sid=>string, initiation to the jid passed
filename=>string, as an argument. Returns the
mode=>string, method (if the users accepts),
timeout=>int) undef (if the user declines),
if the mode is set to "block".
See MODES above for using
the mode and timeout.
=head2 Last Functions
LastQuery(to=>string, - asks the jid specified for its last
mode=>string, activity. If the to is blank, then it
timeout=>int) queries the server. Returns a hash with
LastQuery() the various items set if mode is set to
"block":
$last{seconds} - Seconds since activity
$last{message} - Message for activity
See MODES above for using the mode
and timeout.
LastSend(to=>string, - sends the specified last to the specified jid.
hash) the hash is the seconds and message as shown
in the Net::Jabber::Query man page.
LastActivity() - returns the number of seconds since the last activity
by the user.
=head2 Multi-User Chat Functions
MUCJoin(room=>string, - Sends the appropriate MUC protocol to join
server=>string, the specified room with the specified nick.
nick=>string,
password=>string)
=head2 Register Functions
RegisterSendData(string|JID, - takes the contents of the hash and
hash) builds a jabebr:x:data return packet
which it sends in a Net::Jabber::Query
jabber:iq:register namespace packet.
The first argument is the JID to send
the packet to. This function returns
an array that looks like this:
[ type , message ]
If type is "ok" then registration was
successful, otherwise message contains
a little more detail about the error.
=head2 RPC Functions
RPCParse(IQ object) - returns an array. The first argument tells
the status "ok" or "fault". The second
argument is an array if "ok", or a hash if
"fault".
RPCCall(to=>jid|string, - takes the methodName and params,
methodName=>string, builds the RPC calls and sends it
params=>array, to the specified address. Returns
mode=>string, the above data from RPCParse.
timeout=>int)
See MODES above for using the mode
and timeout.
RPCResponse(to=>jid|string, - generates a response back to
params=>array, the caller. If any part of
faultCode=>int, fault is specified, then it
faultString=>string) wins.
Note: To ensure that you get the correct type for a param sent
back, you can specify the type by prepending the type to
the value:
"i4:5" or "int:5"
"boolean:0"
"string:56"
"double:5.0"
"datetime:20020415T11:11:11"
"base64:...."
RPCSetCallBacks(method=>function, - sets the callback functions
method=>function, for the specified methods.
etc...) The method comes from the
and is case
sensitive. The single
arguemnt is a ref to an
array that contains the
. The function you
write should return one of two
things:
["ok", [...] ]
The [...] is a list of the
you want to return.
["fault", {faultCode=>1,
faultString=>...} ]
If you set the function to undef,
then the method is removed from
the list.
=head2 Search Functions
SearchRequest(to=>string, - send an request to the specified
mode=>string, server/transport, if not specified it
timeout=>int) sends to the current active server.
SearchRequest() The function returns a hash that
contains the required fields. Here
is an example of the hash:
$hash{fields} - The raw fields from
the iq:register. To
be used if there is
no x:data in the
packet.
$hash{instructions} - How to fill out
the form.
$hash{form} - The new dynamic forms.
In $hash{form}, the fields that are
present are the required fields the
server needs.
See MODES above for using the mode
and timeout.
SearchSend(to=>string|JID, - takes the contents of the hash and
hash) passes it to the SetSearch function
in the Net::Jabber::Query
jabber:iq:search namespace. And then
sends the packet.
SearchSendData(string|JID, - takes the contents of the hash and
hash) builds a jabebr:x:data return packet
which it sends in a Net::Jabber::Query
jabber:iq:search namespace packet.
The first argument is the JID to send
the packet to.
=head2 Time Functions
TimeQuery(to=>string, - asks the jid specified for its localtime.
mode=>string, If the to is blank, then it queries the
timeout=>int) server. Returns a hash with the various
TimeQuery() items set if mode is set to "block":
$time{utc} - Time in UTC
$time{tz} - Timezone
$time{display} - Display string
See MODES above for using the mode
and timeout.
TimeSend(to=>string) - sends the current UTC time to the specified
jid.
=head2 Version Functions
VersionQuery(to=>string, - asks the jid specified for its
mode=>string, client version information. If the
timeout=>int) to is blank, then it queries the
VersionQuery() server. Returns ahash with the
various items set if mode is set to
"block":
$version{name} - Name
$version{ver} - Version
$version{os} - Operating System/
Platform
See MODES above for using the mode
and timeout.
VersionSend(to=>string, - sends the specified version information
name=>string, to the jid specified in the to.
ver=>string,
os=>string)
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
use strict;
use Carp;
use vars qw($VERSION);
$VERSION = "2.0";
##############################################################################
# BuildObject takes a root tag and builds the correct object. NEWOBJECT is
# the table that maps tag to package. Override these, or provide new ones.
#-----------------------------------------------------------------------------
$Net::XMPP::Protocol::NEWOBJECT{'iq'} = "Net::Jabber::IQ";
$Net::XMPP::Protocol::NEWOBJECT{'message'} = "Net::Jabber::Message";
$Net::XMPP::Protocol::NEWOBJECT{'presence'} = "Net::Jabber::Presence";
$Net::XMPP::Protocol::NEWOBJECT{'jid'} = "Net::Jabber::JID";
##############################################################################
###############################################################################
#+-----------------------------------------------------------------------------
#|
#| Base API
#|
#+-----------------------------------------------------------------------------
###############################################################################
###############################################################################
#
# Info - set the base information about this Jabber Client/Component for
# use in a default response.
#
###############################################################################
sub Info
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
foreach my $arg (keys(%args))
{
$self->{INFO}->{$arg} = $args{$arg};
}
}
###############################################################################
#
# DefineNamespace - adds the namespace and corresponding functions onto the
# of available functions based on namespace.
#
# Deprecated in favor of AddNamespace
#
###############################################################################
sub DefineNamespace
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
croak("You must specify xmlns=>'' for the function call to DefineNamespace")
if !exists($args{xmlns});
croak("You must specify type=>'' for the function call to DefineNamespace")
if !exists($args{type});
croak("You must specify functions=>'' for the function call to DefineNamespace")
if !exists($args{functions});
my %xpath;
my $tag;
if (exists($args{tag}))
{
$tag = $args{tag};
}
else
{
$tag = "x" if ($args{type} eq "X");
$tag = "query" if ($args{type} eq "Query");
}
foreach my $function (@{$args{functions}})
{
my %tempHash = %{$function};
my %funcHash;
foreach my $func (keys(%tempHash))
{
$funcHash{lc($func)} = $tempHash{$func};
}
croak("You must specify name=>'' for each function in call to DefineNamespace")
if !exists($funcHash{name});
my $name = delete($funcHash{name});
if (!exists($funcHash{set}) && exists($funcHash{get}))
{
croak("The DefineNamespace arugments have changed, and I cannot determine the\nnew values automatically for name($name). Please read the man page\nfor Net::Jabber::Namespaces. I apologize for this incompatability.\n");
}
if (exists($funcHash{type}) || exists($funcHash{path}) ||
exists($funcHash{child}) || exists($funcHash{calls}))
{
foreach my $type (keys(%funcHash))
{
if ($type eq "child")
{
$xpath{$name}->{$type}->{ns} = $funcHash{$type}->[1];
my $i = 2;
while( $i <= $#{$funcHash{$type}} )
{
if ($funcHash{$type}->[$i] eq "__netjabber__:skip_xmlns")
{
$xpath{$name}->{$type}->{skip_xmlns} = 1;
}
if ($funcHash{$type}->[$i] eq "__netjabber__:specifyname")
{
$xpath{$name}->{$type}->{specify_name} = 1;
$i++;
$xpath{$name}->{$type}->{tag} = $funcHash{$type}->[$i+1];
}
$i++;
}
}
else
{
$xpath{$name}->{$type} = $funcHash{$type};
}
}
next;
}
my $type = $funcHash{set}->[0];
my $xpath = $funcHash{set}->[1];
if (exists($funcHash{hash}))
{
$xpath = "text()" if ($funcHash{hash} eq "data");
$xpath .= "/text()" if ($funcHash{hash} eq "child-data");
$xpath = "\@$xpath" if ($funcHash{hash} eq "att");
$xpath = "$1/\@$2" if ($funcHash{hash} =~ /^att-(\S+)-(.+)$/);
}
if ($type eq "master")
{
$xpath{$name}->{type} = $type;
next;
}
if ($type eq "scalar")
{
$xpath{$name}->{path} = $xpath;
next;
}
if ($type eq "flag")
{
$xpath{$name}->{type} = 'flag';
$xpath{$name}->{path} = $xpath;
next;
}
if (($funcHash{hash} eq "child-add") && exists($funcHash{add}))
{
$xpath{$name}->{type} = "node";
$xpath{$name}->{path} = $funcHash{add}->[3];
$xpath{$name}->{child}->{ns} = $funcHash{add}->[1];
$xpath{$name}->{calls} = [ 'Add' ];
next;
}
}
$self->AddNamespace(ns => $args{xmlns},
tag => $tag,
xpath => \%xpath );
}
###############################################################################
#
# AgentsGet - Sends an empty IQ to the server/transport to request that the
# list of supported Agents be sent to them. Returns a hash
# containing the values for the agents.
#
###############################################################################
sub AgentsGet
{
my $self = shift;
my $iq = $self->_iq();
$iq->SetIQ(@_);
$iq->SetIQ(type=>"get");
my $query = $iq->NewQuery("jabber:iq:agents");
$iq = $self->SendAndReceiveWithID($iq);
return unless defined($iq);
$query = $iq->GetQuery();
my @agents = $query->GetAgents();
my %agents;
my $count = 0;
foreach my $agent (@agents)
{
my $jid = $agent->GetJID();
$agents{$jid}->{name} = $agent->GetName();
$agents{$jid}->{description} = $agent->GetDescription();
$agents{$jid}->{transport} = $agent->GetTransport();
$agents{$jid}->{service} = $agent->GetService();
$agents{$jid}->{register} = $agent->DefinedRegister();
$agents{$jid}->{search} = $agent->DefinedSearch();
$agents{$jid}->{groupchat} = $agent->DefinedGroupChat();
$agents{$jid}->{agents} = $agent->DefinedAgents();
$agents{$jid}->{order} = $count++;
}
return %agents;
}
###############################################################################
#
# BrowseRequest - requests the browse information from the specified JID.
#
###############################################################################
sub BrowseRequest
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"get");
my $query = $iq->NewQuery("jabber:iq:browse");
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
$query = $iq->GetQuery();
if (defined($query))
{
my %browse = %{$self->BrowseParse($query)};
return %browse;
}
else
{
return;
}
}
###############################################################################
#
# BrowseParse - helper function for BrowseRequest to convert the object
# tree into a hash for better consumption.
#
###############################################################################
sub BrowseParse
{
my $self = shift;
my $item = shift;
my %browse;
if ($item->DefinedCategory())
{
$browse{category} = $item->GetCategory();
}
else
{
$browse{category} = $item->GetTag();
}
$browse{type} = $item->GetType();
$browse{name} = $item->GetName();
$browse{jid} = $item->GetJID();
$browse{ns} = [ $item->GetNS() ];
foreach my $subitem ($item->GetItems())
{
my ($subbrowse) = $self->BrowseParse($subitem);
push(@{$browse{children}},$subbrowse);
}
return \%browse;
}
###############################################################################
#
# BrowseDBDelete - delete the JID from the DB completely.
#
###############################################################################
sub BrowseDBDelete
{
my $self = shift;
my ($jid) = @_;
my $indexJID = $jid;
$indexJID = $jid->GetJID() if (ref($jid) eq "Net::Jabber::JID");
return if !exists($self->{BROWSEDB}->{$indexJID});
delete($self->{BROWSEDB}->{$indexJID});
$self->{DEBUG}->Log1("BrowseDBDelete: delete ",$indexJID," from the DB");
}
###############################################################################
#
# BrowseDBQuery - retrieve the last Net::Jabber::Browse received with
# the highest priority.
#
###############################################################################
sub BrowseDBQuery
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
$args{timeout} = 10 unless exists($args{timeout});
my $indexJID = $args{jid};
$indexJID = $args{jid}->GetJID() if (ref($args{jid}) eq "Net::Jabber::JID");
if ((exists($args{refresh}) && ($args{refresh} eq "1")) ||
(!exists($self->{BROWSEDB}->{$indexJID})))
{
my %browse = $self->BrowseRequest(jid=>$args{jid},
timeout=>$args{timeout});
$self->{BROWSEDB}->{$indexJID} = \%browse;
}
return %{$self->{BROWSEDB}->{$indexJID}};
}
###############################################################################
#
# ByteStreamsProxyRequest - This queries a proxy server to get a list of
#
###############################################################################
sub ByteStreamsProxyRequest
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"get");
my $query = $iq->NewQuery("http://jabber.org/protocol/bytestreams");
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
$query = $iq->GetQuery();
if (defined($query))
{
my @hosts = @{$self->ByteStreamsProxyParse($query)};
return @hosts;
}
else
{
return;
}
}
###############################################################################
#
# ByteStreamsProxyParse - helper function for ByteStreamProxyRequest to convert
# the object tree into a hash for better consumption.
#
###############################################################################
sub ByteStreamsProxyParse
{
my $self = shift;
my $item = shift;
my @hosts;
foreach my $host ($item->GetStreamHosts())
{
my %host;
$host{jid} = $host->GetJID();
$host{host} = $host->GetHost() if $host->DefinedHost();
$host{port} = $host->GetPort() if $host->DefinedPort();
$host{zeroconf} = $host->GetZeroConf() if $host->DefinedZeroConf();
push(@hosts,\%host);
}
return \@hosts;
}
###############################################################################
#
# ByteStreamsProxyActivate - This tells a proxy to activate the connection
#
###############################################################################
sub ByteStreamsProxyActivate
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"set");
my $query = $iq->NewQuery("http://jabber.org/protocol/bytestreams");
$query->SetByteStreams(sid=>$args{sid},
activate=>(ref($args{recipient}) eq "Net::Jabber::JID" ? $args{recipient}->GetJID("full") : $args{recipient})
);
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
return 1;
}
###############################################################################
#
# ByteStreamsOffer - This offers a recipient a list of stream hosts to pick
# from.
#
###############################################################################
sub ByteStreamsOffer
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"set");
my $query = $iq->NewQuery("http://jabber.org/protocol/bytestreams");
$query->SetByteStreams(sid=>$args{sid});
foreach my $host (@{$args{streamhosts}})
{
$query->AddStreamHost(jid=>$host->{jid},
(exists($host->{host}) ? (host=>$host->{host}) : ()),
(exists($host->{port}) ? (port=>$host->{port}) : ()),
(exists($host->{zeroconf}) ? (zeroconf=>$host->{zeroconf}) : ()),
);
}
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
$query = $iq->GetQuery();
if (defined($query))
{
return $query->GetStreamHostUsedJID();
}
else
{
return;
}
}
###############################################################################
#
# DiscoInfoRequest - requests the disco information from the specified JID.
#
###############################################################################
sub DiscoInfoRequest
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"get");
my $query = $iq->NewQuery("http://jabber.org/protocol/disco#info");
$query->SetDiscoInfo(node=>$args{node}) if exists($args{node});
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
return unless $iq->DefinedQuery();
$query = $iq->GetQuery();
return %{$self->DiscoInfoParse($query)};
}
###############################################################################
#
# DiscoInfoParse - helper function for DiscoInfoRequest to convert the object
# tree into a hash for better consumption.
#
###############################################################################
sub DiscoInfoParse
{
my $self = shift;
my $item = shift;
my %disco;
foreach my $ident ($item->GetIdentities())
{
my %identity;
$identity{category} = $ident->GetCategory();
$identity{name} = $ident->GetName();
$identity{type} = $ident->GetType();
push(@{$disco{identity}},\%identity);
}
foreach my $feat ($item->GetFeatures())
{
$disco{feature}->{$feat->GetVar()} = 1;
}
return \%disco;
}
###############################################################################
#
# DiscoItemsRequest - requests the disco information from the specified JID.
#
###############################################################################
sub DiscoItemsRequest
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"get");
my $query = $iq->NewQuery("http://jabber.org/protocol/disco#items");
$query->SetDiscoItems(node=>$args{node}) if exists($args{node});
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
$query = $iq->GetQuery();
if (defined($query))
{
my %disco = %{$self->DiscoItemsParse($query)};
return %disco;
}
else
{
return;
}
}
###############################################################################
#
# DiscoItemsParse - helper function for DiscoItemsRequest to convert the object
# tree into a hash for better consumption.
#
###############################################################################
sub DiscoItemsParse
{
my $self = shift;
my $item = shift;
my %disco;
foreach my $item ($item->GetItems())
{
$disco{$item->GetJID()}->{$item->GetNode()} = $item->GetName();
}
return \%disco;
}
###############################################################################
#
# FeatureNegRequest - requests a feature negotiation from the specified JID.
#
###############################################################################
sub FeatureNegRequest
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"get");
my $query = $self->FeatureNegQuery($args{features});
$iq->AddQuery($query);
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
$query = $iq->GetQuery();
if (defined($query))
{
my %feats = %{$self->FeatureNegParse($query)};
return %feats;
}
else
{
return;
}
}
#xxx fneg needs to reutrn a type='submit' on the x:data in a result
###############################################################################
#
# FeatureNegQuery - given a feature hash, return a query that contains it.
#
###############################################################################
sub FeatureNegQuery
{
my $self = shift;
my $features = shift;
my $tag = "query";
$tag = $Net::Jabber::Query::TAGS{'http://jabber.org/protocol/feature-neg'}
if exists($Net::Jabber::Query::TAGS{'http://jabber.org/protocol/feature-neg'});
my $query = new Net::Jabber::Query($tag);
$query->SetXMLNS("http://jabber.org/protocol/feature-neg");
my $xdata = $query->NewX("jabber:x:data");
foreach my $feature (keys(%{$features}))
{
my $field = $xdata->AddField(type=>"list-single",
var=>$feature);
foreach my $value (@{$features->{$feature}})
{
$field->AddOption(value=>$value);
}
}
return $query;
}
###############################################################################
#
# FeatureNegParse - helper function for FeatureNegRequest to convert the object
# tree into a hash for better consumption.
#
###############################################################################
sub FeatureNegParse
{
my $self = shift;
my $item = shift;
my %feats;
my $xdata = $item->GetX("jabber:x:data");
foreach my $field ($xdata->GetFields())
{
my @options;
foreach my $option ($field->GetOptions())
{
push(@options,$option->GetValue());
}
if ($#options == -1)
{
$feats{$field->GetVar()} = $field->GetValue();
}
else
{
$feats{$field->GetVar()} = \@options;
}
}
return \%feats;
}
#XXX - need a feature-neg answer function...
###############################################################################
#
# FileTransferOffer - offer a file transfer JEP-95
#
###############################################################################
sub FileTransferOffer
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"set");
my $query = $iq->NewQuery("http://jabber.org/protocol/si");
my $profile = $query->NewQuery("http://jabber.org/protocol/si/profile/file-transfer");
# XXX support hashing via MD5
# XXX support date via JEP-82
my ($filename) = ($args{filename} =~ /\/?([^\/]+)$/);
$profile->SetFile(name=>$filename,
size=>(-s $args{filename})
);
$profile->SetFile(desc=>$args{desc}) if exists($args{desc});
$query->SetStream(mimetype=>(-B $args{filename} ?
"application/octect-stream" :
"text/plain"
),
id=>$args{sid},
profile=>"http://jabber.org/protocol/si/profile/file-transfer"
);
if (!exists($args{skip_methods}))
{
if ($#{$args{methods}} == -1)
{
print STDERR "You did not provide any valid methods for file transfer.\n";
return;
}
my $fneg = $self->FeatureNegQuery({'stream-method'=>$args{methods}});
$query->AddQuery($fneg);
}
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
$query = $iq->GetQuery();
if (defined($query))
{
my @fneg = $query->GetQuery("http://jabber.org/protocol/feature-neg");
my @xdata = $fneg[0]->GetX("jabber:x:data");
my @fields = $xdata[0]->GetFields();
return $fields[0]->GetValue();
# XXX need better error handling
}
else
{
return;
}
}
###############################################################################
#
# TreeTransferOffer - offer a file transfer JEP-95
#
###############################################################################
sub TreeTransferOffer
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>$args{jid},
type=>"set");
my $query = $iq->NewQuery("http://jabber.org/protocol/si");
my $profile = $query->NewQuery("http://jabber.org/protocol/si/profile/tree-transfer");
my ($root) = ($args{directory} =~ /\/?([^\/]+)$/);
my $rootDir = $profile->AddDirectory(name=>$root);
my %tree;
$tree{counter} = 0;
$self->TreeTransferDescend($args{sidbase},
$args{directory},
$rootDir,
\%tree
);
$profile->SetTree(numfiles=>$tree{counter},
size=>$tree{size}
);
$query->SetStream(id=>$args{sidbase},
profile=>"http://jabber.org/protocol/si/profile/tree-transfer"
);
if ($#{$args{methods}} == -1)
{
print STDERR "You did not provide any valid methods for the tree transfer.\n";
return;
}
my $fneg = $self->FeatureNegQuery({'stream-method'=>$args{methods}});
$query->AddQuery($fneg);
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
$tree{id} = $id;
return %tree;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
return;
}
$query = $iq->GetQuery();
if (defined($query))
{
my @fneg = $query->GetQuery("http://jabber.org/protocol/feature-neg");
my @xdata = $fneg[0]->GetX("jabber:x:data");
my @fields = $xdata[0]->GetFields();
return $fields[0]->GetValue();
# XXX need better error handling
}
else
{
return;
}
}
###############################################################################
#
# TreeTransferDescend - descend a directory structure and build the packet.
#
###############################################################################
sub TreeTransferDescend
{
my $self = shift;
my $sidbase = shift;
my $path = shift;
my $parent = shift;
my $tree = shift;
$tree->{size} += (-s $path);
opendir(DIR, $path);
foreach my $file ( sort {$a cmp $b} readdir(DIR) )
{
next if ($file =~ /^\.\.?$/);
if (-d "$path/$file")
{
my $tempParent = $parent->AddDirectory(name=>$file);
$self->TreeTransferDescend($sidbase,
"$path/$file",
$tempParent,
$tree
);
}
else
{
$tree->{size} += (-s "$path/$file");
$tree->{tree}->{"$path/$file"}->{order} = $tree->{counter};
$tree->{tree}->{"$path/$file"}->{sid} =
$sidbase."-".$tree->{counter};
$tree->{tree}->{"$path/$file"}->{name} = $file;
$parent->AddFile(name=>$tree->{tree}->{"$path/$file"}->{name},
sid=>$tree->{tree}->{"$path/$file"}->{sid});
$tree->{counter}++;
}
}
closedir(DIR);
}
###############################################################################
#
# LastQuery - Sends an iq:last query to either the server or the specified
# JID.
#
###############################################################################
sub LastQuery
{
my $self = shift;
my %args;
$args{mode} = "passthru";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
$args{waitforid} = 0 unless exists($args{waitforid});
my $waitforid = delete($args{waitforid});
$args{mode} = "block" if $waitforid;
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
$iq->SetIQ(type=>'get');
my $last = $iq->NewQuery("jabber:iq:last");
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
return unless defined($iq);
$last = $iq->GetQuery();
return unless defined($last);
return $last->GetLast();
}
###############################################################################
#
# LastSend - sends an iq:last packet to the specified user.
#
###############################################################################
sub LastSend
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
$args{ignoreactivity} = 0 unless exists($args{ignoreactivity});
my $ignoreActivity = delete($args{ignoreactivity});
my $iq = $self->_iq();
$iq->SetIQ(to=>delete($args{to}),
type=>'result');
my $last = $iq->NewQuery("jabber:iq:last");
$last->SetLast(%args);
$self->Send($iq,$ignoreActivity);
}
###############################################################################
#
# LastActivity - returns number of seconds since the last activity.
#
###############################################################################
sub LastActivity
{
my $self = shift;
return (time - $self->{STREAM}->LastActivity($self->{SESSION}->{id}));
}
###############################################################################
#
# RegisterSendData - This is a self contained function to send a register iq
# tag with an id. It uses the jabber:x:data method to
# return the data.
#
###############################################################################
sub RegisterSendData
{
my $self = shift;
my $to = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
#--------------------------------------------------------------------------
# Create a Net::Jabber::IQ object to send to the server
#--------------------------------------------------------------------------
my $iq = $self->_iq();
$iq->SetIQ(to=>$to) if (defined($to) && ($to ne ""));
$iq->SetIQ(type=>"set");
my $iqRegister = $iq->NewQuery("jabber:iq:register");
my $xForm = $iqRegister->NewX("jabber:x:data");
foreach my $var (keys(%args))
{
next if ($args{$var} eq "");
$xForm->AddField(var=>$var,
value=>$args{$var}
);
}
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
$iq = $self->SendAndReceiveWithID($iq);
#--------------------------------------------------------------------------
# From the reply IQ determine if we were successful or not. If yes then
# return "". If no then return error string from the reply.
#--------------------------------------------------------------------------
return unless defined($iq);
return ( $iq->GetErrorCode() , $iq->GetError() )
if ($iq->GetType() eq "error");
return ("ok","");
}
###############################################################################
#
# RPCSetCallBacks - place to register a callback for RPC calls. This is
# used in conjunction with the default IQ callback.
#
###############################################################################
sub RPCSetCallBacks
{
my $self = shift;
while($#_ >= 0) {
my $func = pop(@_);
my $method = pop(@_);
$self->{DEBUG}->Log2("RPCSetCallBacks: method($method) func($func)");
if (defined($func))
{
$self->{RPCCB}{$method} = $func;
}
else
{
delete($self->{RPCCB}{$method});
}
}
}
###############################################################################
#
# RPCCall - Make an RPC call to the specified JID.
#
###############################################################################
sub RPCCall
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(type=>"set",
to=>delete($args{to}));
$iq->AddQuery($self->RPCEncode(type=>"methodCall",
%args));
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
return unless defined($iq);
return $self->RPCParse($iq);
}
###############################################################################
#
# RPCResponse - Send back an RPC response, or fault, to the specified JID.
#
###############################################################################
sub RPCResponse
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $iq = $self->_iq();
$iq->SetIQ(type=>"result",
to=>delete($args{to}));
$iq->AddQuery($self->RPCEncode(type=>"methodResponse",
%args));
$iq = $self->SendAndReceiveWithID($iq);
return unless defined($iq);
return $self->RPCParse($iq);
}
###############################################################################
#
# RPCEncode - Returns a Net::Jabber::Query with the arguments encoded for the
# RPC packet.
#
###############################################################################
sub RPCEncode
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $query = new Net::Jabber::Stanza("query");
$query->SetXMLNS("jabber:iq:rpc");
my $source;
if ($args{type} eq "methodCall")
{
$source = $query->AddMethodCall();
$source->SetMethodName($args{methodname});
}
if ($args{type} eq "methodResponse")
{
$source = $query->AddMethodResponse();
}
if (exists($args{faultcode}) || exists($args{faultstring}))
{
my $struct = $source->AddFault()->AddValue()->AddStruct();
$struct->AddMember(name=>"faultCode")->AddValue(i4=>$args{faultcode});
$struct->AddMember(name=>"faultString")->AddValue(string=>$args{faultstring});
}
elsif (exists($args{params}))
{
my $params = $source->AddParams();
foreach my $param (@{$args{params}})
{
$self->RPCEncode_Value($params->AddParam(),$param);
}
}
return $query;
}
###############################################################################
#
# RPCEncode_Value - Run through the value, and encode it into XML.
#
###############################################################################
sub RPCEncode_Value
{
my $self = shift;
my $obj = shift;
my $value = shift;
if (ref($value) eq "ARRAY")
{
my $array = $obj->AddValue()->AddArray();
foreach my $data (@{$value})
{
$self->RPCEncode_Value($array->AddData(),$data);
}
}
elsif (ref($value) eq "HASH")
{
my $struct = $obj->AddValue()->AddStruct();
foreach my $key (keys(%{$value}))
{
$self->RPCEncode_Value($struct->AddMember(name=>$key),$value->{$key});
}
}
else
{
if ($value =~ /^(int|i4|boolean|string|double|datetime|base64):/i)
{
my $type = $1;
my($val) = ($value =~ /^$type:(.*)$/);
$obj->AddValue($type=>$val);
}
elsif ($value =~ /^[+-]?\d+$/)
{
$obj->AddValue(i4=>$value);
}
elsif ($value =~ /^(-?(?:\d+(?:\.\d*)?|\.\d+)|([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)$/)
{
$obj->AddValue(double=>$value);
}
else
{
$obj->AddValue(string=>$value);
}
}
}
###############################################################################
#
# RPCParse - Returns an array of the params sent in the RPC packet.
#
###############################################################################
sub RPCParse
{
my $self = shift;
my($iq) = @_;
my $query = $iq->GetQuery();
my $source;
$source = $query->GetMethodCall() if $query->DefinedMethodCall();
$source = $query->GetMethodResponse() if $query->DefinedMethodResponse();
if (defined($source))
{
if (($source->GetTag() eq "methodResponse") && ($source->DefinedFault()))
{
my %response =
$self->RPCParse_Struct($source->GetFault()->GetValue()->GetStruct());
return ("fault",\%response);
}
if ($source->DefinedParams())
{
#------------------------------------------------------------------
# The s part
#------------------------------------------------------------------
my @response;
foreach my $param ($source->GetParams()->GetParams())
{
push(@response,$self->RPCParse_Value($param->GetValue()));
}
return ("ok",\@response);
}
}
else
{
print "AAAAHHHH!!!!\n";
}
}
###############################################################################
#
# RPCParse_Value - Takes a and returns the data it represents
#
###############################################################################
sub RPCParse_Value
{
my $self = shift;
my($value) = @_;
if ($value->DefinedStruct())
{
my %struct = $self->RPCParse_Struct($value->GetStruct());
return \%struct;
}
if ($value->DefinedArray())
{
my @array = $self->RPCParse_Array($value->GetArray());
return \@array;
}
return $value->GetI4() if $value->DefinedI4();
return $value->GetInt() if $value->DefinedInt();
return $value->GetBoolean() if $value->DefinedBoolean();
return $value->GetString() if $value->DefinedString();
return $value->GetDouble() if $value->DefinedDouble();
return $value->GetDateTime() if $value->DefinedDateTime();
return $value->GetBase64() if $value->DefinedBase64();
return $value->GetValue();
}
###############################################################################
#
# RPCParse_Struct - Takes a and returns the hash of values.
#
###############################################################################
sub RPCParse_Struct
{
my $self = shift;
my($struct) = @_;
my %struct;
foreach my $member ($struct->GetMembers())
{
$struct{$member->GetName()} = $self->RPCParse_Value($member->GetValue());
}
return %struct;
}
###############################################################################
#
# RPCParse_Array - Takes a and returns the hash of values.
#
###############################################################################
sub RPCParse_Array
{
my $self = shift;
my($array) = @_;
my @array;
foreach my $data ($array->GetDatas())
{
push(@array,$self->RPCParse_Value($data->GetValue()));
}
return @array;
}
###############################################################################
#
# SearchRequest - This is a self contained function to send an iq tag
# an id that requests the target address to send back
# the required fields. It waits for a reply what the
# same id to come back and tell the caller what the
# fields are.
#
###############################################################################
sub SearchRequest
{
my $self = shift;
my %args;
$args{mode} = "block";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
#--------------------------------------------------------------------------
# Create a Net::Jabber::IQ object to send to the server
#--------------------------------------------------------------------------
my $iq = $self->_iq();
$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
$iq->SetIQ(type=>"get");
my $query = $iq->NewQuery("jabber:iq:search");
$self->{DEBUG}->Log1("SearchRequest: sent(",$iq->GetXML(),")");
#--------------------------------------------------------------------------
# Send the IQ with the next available ID and wait for a reply with that
# id to be received. Then grab the IQ reply.
#--------------------------------------------------------------------------
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
$self->{DEBUG}->Log1("SearchRequest: received(",$iq->GetXML(),")")
if defined($iq);
#--------------------------------------------------------------------------
# Check if there was an error.
#--------------------------------------------------------------------------
return unless defined($iq);
if ($iq->GetType() eq "error")
{
$self->SetErrorCode($iq->GetErrorCode().": ".$iq->GetError());
$self->{DEBUG}->Log1("SearchRequest: error(",$self->GetErrorCode(),")");
return;
}
my %search;
#--------------------------------------------------------------------------
# From the reply IQ determine what fields are required and send a hash
# back with the fields and any values that are already defined (like key)
#--------------------------------------------------------------------------
$query = $iq->GetQuery();
$search{fields} = { $query->GetSearch() };
#--------------------------------------------------------------------------
# Get any forms so that we have the option of showing a nive dynamic form
# to the user and not just a bunch of fields.
#--------------------------------------------------------------------------
&ExtractForms(\%search,$query->GetX("jabber:x:data"));
#--------------------------------------------------------------------------
# Get any oobs so that we have the option of sending the user to the http
# form and not a dynamic one.
#--------------------------------------------------------------------------
&ExtractOobs(\%search,$query->GetX("jabber:x:oob"));
return %search;
}
###############################################################################
#
# SearchSend - This is a self contained function to send a search
# iq tag with an id. Then wait for a reply what the same
# id to come back and tell the caller what the result was.
#
###############################################################################
sub SearchSend
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
#--------------------------------------------------------------------------
# Create a Net::Jabber::IQ object to send to the server
#--------------------------------------------------------------------------
my $iq = $self->_iq();
$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
$iq->SetIQ(type=>"set");
my $iqSearch = $iq->NewQuery("jabber:iq:search");
$iqSearch->SetSearch(%args);
#--------------------------------------------------------------------------
# Send the IQ.
#--------------------------------------------------------------------------
$self->Send($iq);
}
###############################################################################
#
# SearchSendData - This is a self contained function to send a search iq tag
# with an id. It uses the jabber:x:data method to return the
# data.
#
###############################################################################
sub SearchSendData
{
my $self = shift;
my $to = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
#--------------------------------------------------------------------------
# Create a Net::Jabber::IQ object to send to the server
#--------------------------------------------------------------------------
my $iq = $self->_iq();
$iq->SetIQ(to=>$to) if (defined($to) && ($to ne ""));
$iq->SetIQ(type=>"set");
my $iqSearch = $iq->NewQuery("jabber:iq:search");
my $xForm = $iqSearch->NewX("jabber:x:data");
foreach my $var (keys(%args))
{
next if ($args{$var} eq "");
$xForm->AddField(var=>$var,
value=>$args{$var}
);
}
#--------------------------------------------------------------------------
# Send the IQ.
#--------------------------------------------------------------------------
$self->Send($iq);
}
###############################################################################
#
# TimeQuery - Sends an iq:time query to either the server or the specified
# JID.
#
###############################################################################
sub TimeQuery
{
my $self = shift;
my %args;
$args{mode} = "passthru";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
$args{waitforid} = 0 unless exists($args{waitforid});
my $waitforid = delete($args{waitforid});
$args{mode} = "block" if $waitforid;
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
$iq->SetIQ(type=>'get',%args);
my $time = $iq->NewQuery("jabber:iq:time");
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
return unless defined($iq);
my $query = $iq->GetQuery();
return unless defined($query);
my %result;
$result{utc} = $query->GetUTC();
$result{display} = $query->GetDisplay();
$result{tz} = $query->GetTZ();
return %result;
}
###############################################################################
#
# TimeSend - sends an iq:time packet to the specified user.
#
###############################################################################
sub TimeSend
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $iq = $self->_iq();
$iq->SetIQ(to=>delete($args{to}),
type=>'result');
my $time = $iq->NewQuery("jabber:iq:time");
$time->SetTime(%args);
$self->Send($iq);
}
###############################################################################
#
# VersionQuery - Sends an iq:version query to either the server or the
# specified JID.
#
###############################################################################
sub VersionQuery
{
my $self = shift;
my %args;
$args{mode} = "passthru";
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
$args{waitforid} = 0 unless exists($args{waitforid});
my $waitforid = delete($args{waitforid});
$args{mode} = "block" if $waitforid;
my $timeout = exists($args{timeout}) ? delete($args{timeout}) : undef;
my $iq = $self->_iq();
$iq->SetIQ(to=>delete($args{to})) if exists($args{to});
$iq->SetIQ(type=>'get',%args);
my $version = $iq->NewQuery("jabber:iq:version");
if ($args{mode} eq "passthru")
{
my $id = $self->UniqueID();
$iq->SetIQ(id=>$id);
$self->Send($iq);
return $id;
}
return $self->SendWithID($iq) if ($args{mode} eq "nonblock");
$iq = $self->SendAndReceiveWithID($iq,$timeout);
return unless defined($iq);
my $query = $iq->GetQuery();
return unless defined($query);
my %result;
$result{name} = $query->GetName();
$result{ver} = $query->GetVer();
$result{os} = $query->GetOS();
return %result;
}
###############################################################################
#
# VersionSend - sends an iq:version packet to the specified user.
#
###############################################################################
sub VersionSend
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $iq = $self->_iq();
$iq->SetIQ(to=>delete($args{to}),
type=>'result');
my $version = $iq->NewQuery("jabber:iq:version");
$version->SetVersion(%args);
$self->Send($iq);
}
###############################################################################
#
# MUCJoin - join a MUC room
#
###############################################################################
sub MUCJoin
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $presence = $self->_presence();
$presence->SetTo($args{room}.'@'.$args{server}.'/'.$args{nick});
my $x = $presence->NewChild("http://jabber.org/protocol/muc");
if (exists($args{password}) && ($args{password} ne ""))
{
$x->SetMUC(password=>$args{password});
}
return $presence->GetXML() if exists($args{'__netjabber__:test'});
$self->Send($presence);
}
###############################################################################
#+-----------------------------------------------------------------------------
#|
#| Helper Functions
#|
#+-----------------------------------------------------------------------------
###############################################################################
###############################################################################
#
# ExtractForms - Helper function to make extracting jabber:x:data for forms
# more centrally definable.
#
###############################################################################
sub ExtractForms
{
my ($target,@xForms) = @_;
my $tempVar = "1";
foreach my $xForm (@xForms) {
$target->{instructions} = $xForm->GetInstructions();
my $order = 0;
foreach my $field ($xForm->GetFields())
{
$target->{form}->[$order]->{type} = $field->GetType()
if $field->DefinedType();
$target->{form}->[$order]->{label} = $field->GetLabel()
if $field->DefinedLabel();
$target->{form}->[$order]->{desc} = $field->GetDesc()
if $field->DefinedDesc();
$target->{form}->[$order]->{var} = $field->GetVar()
if $field->DefinedVar();
$target->{form}->[$order]->{var} = "__netjabber__:tempvar:".$tempVar++
if !$field->DefinedVar();
if ($field->DefinedValue())
{
if ($field->GetType() eq "list-multi")
{
$target->{form}->[$order]->{value} = [ $field->GetValue() ];
}
else
{
$target->{form}->[$order]->{value} = ($field->GetValue())[0];
}
}
my $count = 0;
foreach my $option ($field->GetOptions())
{
$target->{form}->[$order]->{options}->[$count]->{value} =
$option->GetValue();
$target->{form}->[$order]->{options}->[$count]->{label} =
$option->GetLabel();
$count++;
}
$order++;
}
foreach my $reported ($xForm->GetReported())
{
my $order = 0;
foreach my $field ($reported->GetFields())
{
$target->{reported}->[$order]->{label} = $field->GetLabel();
$target->{reported}->[$order]->{var} = $field->GetVar();
$order++;
}
}
}
}
###############################################################################
#
# ExtractOobs - Helper function to make extracting jabber:x:oob for forms
# more centrally definable.
#
###############################################################################
sub ExtractOobs
{
my ($target,@xOobs) = @_;
foreach my $xOob (@xOobs)
{
$target->{oob}->{url} = $xOob->GetURL();
$target->{oob}->{desc} = $xOob->GetDesc();
}
}
###############################################################################
#+-----------------------------------------------------------------------------
#|
#| Default CallBacks
#|
#+-----------------------------------------------------------------------------
###############################################################################
###############################################################################
#
# callbackInit - initialize the default callbacks
#
###############################################################################
sub callbackInit
{
my $self = shift;
$self->SUPER::callbackInit();
$self->SetIQCallBacks("jabber:iq:last"=>
{
get=>sub{ $self->callbackGetIQLast(@_) },
result=>sub{ $self->callbackResultIQLast(@_) }
},
"jabber:iq:rpc"=>
{
set=>sub{ $self->callbackSetIQRPC(@_) },
},
"jabber:iq:time"=>
{
get=>sub{ $self->callbackGetIQTime(@_) },
result=>sub{ $self->callbackResultIQTime(@_) }
},
"jabber:iq:version"=>
{
get=>sub{ $self->callbackGetIQVersion(@_) },
result=>sub{ $self->callbackResultIQVersion(@_) }
},
);
}
###############################################################################
#
# callbackSetIQRPC - callback to handle auto-replying to an iq:rpc by calling
# the user registered functions.
#
###############################################################################
sub callbackSetIQRPC
{
my $self = shift;
my $sid = shift;
my $iq = shift;
my $query = $iq->GetQuery();
my $reply = $iq->Reply(type=>"result");
my $replyQuery = $reply->GetQuery();
if (!$query->DefinedMethodCall())
{
my $methodResponse = $replyQuery->AddMethodResponse();
my $struct = $methodResponse->AddFault()->AddValue()->AddStruct();
$struct->AddMember(name=>"faultCode")->AddValue(int=>400);
$struct->AddMember(name=>"faultString")->AddValue(string=>"Missing methodCall.");
$self->Send($reply,1);
return;
}
if (!$query->GetMethodCall()->DefinedMethodName())
{
my $methodResponse = $replyQuery->AddMethodResponse();
my $struct = $methodResponse->AddFault()->AddValue()->AddStruct();
$struct->AddMember(name=>"faultCode")->AddValue(int=>400);
$struct->AddMember(name=>"faultString")->AddValue(string=>"Missing methodName.");
$self->Send($reply,1);
return;
}
my $methodName = $query->GetMethodCall()->GetMethodName();
if (!exists($self->{RPCCB}->{$methodName}))
{
my $methodResponse = $replyQuery->AddMethodResponse();
my $struct = $methodResponse->AddFault()->AddValue()->AddStruct();
$struct->AddMember(name=>"faultCode")->AddValue(int=>404);
$struct->AddMember(name=>"faultString")->AddValue(string=>"methodName $methodName not defined.");
$self->Send($reply,1);
return;
}
my @params = $self->RPCParse($iq);
my @return = &{$self->{RPCCB}->{$methodName}}($iq,$params[1]);
if ($return[0] ne "ok") {
my $methodResponse = $replyQuery->AddMethodResponse();
my $struct = $methodResponse->AddFault()->AddValue()->AddStruct();
$struct->AddMember(name=>"faultCode")->AddValue(int=>$return[1]->{faultCode});
$struct->AddMember(name=>"faultString")->AddValue(string=>$return[1]->{faultString});
$self->Send($reply,1);
return;
}
$reply->RemoveQuery();
$reply->AddQuery($self->RPCEncode(type=>"methodResponse",
params=>$return[1]));
$self->Send($reply,1);
}
###############################################################################
#
# callbackGetIQTime - callback to handle auto-replying to an iq:time get.
#
###############################################################################
sub callbackGetIQTime
{
my $self = shift;
my $sid = shift;
my $iq = shift;
my $query = $iq->GetQuery();
my $reply = $iq->Reply(type=>"result");
my $replyQuery = $reply->GetQuery();
$replyQuery->SetTime();
$self->Send($reply,1);
}
###############################################################################
#
# callbackResultIQTime - callback to handle formatting iq:time result into
# a message.
#
###############################################################################
sub callbackResultIQTime
{
my $self = shift;
my $sid = shift;
my $iq = shift;
my $fromJID = $iq->GetFrom("jid");
my $query = $iq->GetQuery();
my $body = "UTC: ".$query->GetUTC()."\n";
$body .= "Time: ".$query->GetDisplay()."\n";
$body .= "Timezone: ".$query->GetTZ()."\n";
my $message = $self->_message();
$message->SetMessage(to=>$iq->GetTo(),
from=>$iq->GetFrom(),
subject=>"CTCP: Time",
body=>$body);
$self->CallBack($sid,$message);
}
###############################################################################
#
# callbackGetIQVersion - callback to handle auto-replying to an iq:time
# get.
#
###############################################################################
sub callbackGetIQVersion
{
my $self = shift;
my $sid = shift;
my $iq = shift;
my $query = $iq->GetQuery();
my $reply = $iq->Reply(type=>"result");
my $replyQuery = $reply->GetQuery();
$replyQuery->SetVersion(name=>$self->{INFO}->{name},
ver=>$self->{INFO}->{version},
os=>"");
$self->Send($reply,1);
}
###############################################################################
#
# callbackResultIQVersion - callback to handle formatting iq:time result
# into a message.
#
###############################################################################
sub callbackResultIQVersion
{
my $self = shift;
my $sid = shift;
my $iq = shift;
my $query = $iq->GetQuery();
my $body = "Program: ".$query->GetName()."\n";
$body .= "Version: ".$query->GetVer()."\n";
$body .= "OS: ".$query->GetOS()."\n";
my $message = $self->_message();
$message->SetMessage(to=>$iq->GetTo(),
from=>$iq->GetFrom(),
subject=>"CTCP: Version",
body=>$body);
$self->CallBack($sid,$message);
}
###############################################################################
#
# callbackGetIQLast - callback to handle auto-replying to an iq:last get.
#
###############################################################################
sub callbackGetIQLast
{
my $self = shift;
my $sid = shift;
my $iq = shift;
my $query = $iq->GetQuery();
my $reply = $iq->Reply(type=>"result");
my $replyQuery = $reply->GetQuery();
$replyQuery->SetLast(seconds=>$self->LastActivity());
$self->Send($reply,1);
}
###############################################################################
#
# callbackResultIQLast - callback to handle formatting iq:last result into
# a message.
#
###############################################################################
sub callbackResultIQLast
{
my $self = shift;
my $sid = shift;
my $iq = shift;
my $fromJID = $iq->GetFrom("jid");
my $query = $iq->GetQuery();
my $seconds = $query->GetSeconds();
my $lastTime = &Net::Jabber::GetTimeStamp("local",(time - $seconds),"long");
my $elapsedTime = &Net::Jabber::GetHumanTime($seconds);
my $body;
if ($fromJID->GetUserID() eq "")
{
$body = "Start Time: $lastTime\n";
$body .= "Up time: $elapsedTime\n";
$body .= "Message: ".$query->GetMessage()."\n"
if ($query->DefinedMessage());
}
elsif ($fromJID->GetResource() eq "")
{
$body = "Logout Time: $lastTime\n";
$body .= "Elapsed time: $elapsedTime\n";
$body .= "Message: ".$query->GetMessage()."\n"
if ($query->DefinedMessage());
}
else
{
$body = "Last activity: $lastTime\n";
$body .= "Elapsed time: $elapsedTime\n";
$body .= "Message: ".$query->GetMessage()."\n"
if ($query->DefinedMessage());
}
my $message = $self->_message();
$message->SetMessage(from=>$iq->GetFrom(),
subject=>"Last Activity",
body=>$body);
$self->CallBack($sid,$message);
}
1;
Net-Jabber-2.0/lib/Net/Jabber/XDB.pm 0000644 0001750 0001750 00000033550 10110275744 020063 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Jabber
# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################
package Net::Jabber::XDB;
=head1 NAME
Net::Jabber::XDB - Jabber XDB Library
=head1 SYNOPSIS
Net::Jabber::XDB is a companion to the Net::Jabber module. It
provides the user a simple interface to set and retrieve all
parts of a Jabber XDB.
=head1 DESCRIPTION
Net::Jabber::XDB differs from the other Net::Jabber::* modules in that
the XMLNS of the data is split out into more submodules under
XDB. For specifics on each module please view the documentation
for each Net::Jabber::Data::* module. To see the list of avilable
namspaces and modules see Net::Jabber::Data.
To initialize the XDB with a Jabber you must pass it the
XML::Parser Tree array. For example:
my $xdb = new Net::Jabber::XDB(@tree);
There has been a change from the old way of handling the callbacks.
You no longer have to do the above, a Net::Jabber::XDB object is passed
to the callback function for the xdb:
use Net::Jabber qw(Component);
sub xdb {
my ($XDB) = @_;
.
.
.
}
You now have access to all of the retrieval functions available.
To create a new xdb to send to the server:
use Net::Jabber;
$XDB = new Net::Jabber::XDB();
$XDBType = $XDB->NewData( type );
$XDBType->SetXXXXX("yyyyy");
Now you can call the creation functions for the XDB, and for the
on the new Data object itself. See below for the functions, and
in each data module for those functions.
For more information about the array format being passed to the CallBack
please read the Net::Jabber::Client documentation.
=head1 METHODS
=head2 Retrieval functions
GetTo() - returns either a string with the Jabber Identifier,
GetTo("jid") or a Net::Jabber::JID object for the person who is
going to receive the . To get the JID
object set the string to "jid", otherwise leave
blank for the text string.
$to = $XDB->GetTo();
$toJID = $XDB->GetTo("jid");
GetFrom() - returns either a string with the Jabber Identifier,
GetFrom("jid") or a Net::Jabber::JID object for the person who
sent the . To get the JID object set
the string to "jid", otherwise leave blank for the
text string.
$from = $XDB->GetFrom();
$fromJID = $XDB->GetFrom("jid");
GetType() - returns a string with the type this is.
$type = $XDB->GetType();
GetID() - returns an integer with the id of the .
$id = $XDB->GetID();
GetAction() - returns a string with the action this is.
$action = $XDB->GetAction();
GetMatch() - returns a string with the match this is.
$match = $XDB->GetMatch();
GetError() - returns a string with the text description of the error.
$error = $XDB->GetError();
GetErrorCode() - returns a string with the code of error.
$errorCode = $XDB->GetErrorCode();
GetData() - returns a Net::Jabber::Data object that contains the data
in the of the .
$dataTag = $XDB->GetData();
GetDataXMLNS() - returns a string with the namespace of the data
for this , if one exists.
$xmlns = $XDB->GetDataXMLNS();
=head2 Creation functions
SetXDB(to=>string|JID, - set multiple fields in the at one
from=>string|JID, time. This is a cumulative and over
id=>string, writing action. If you set the "to"
type=>string, attribute twice, the second setting is
action=>string, what is used. If you set the status, and
match=>string) then set the priority then both will be in
errorcode=>string, the tag. For valid settings read the
error=>string) specific Set functions below.
$XDB->SetXDB(type=>"get",
to=>"bob\@jabber.org",
data=>"info");
$XDB->SetXDB(to=>"bob\@jabber.org",
errorcode=>403,
error=>"Permission Denied");
SetTo(string) - sets the to attribute. You can either pass a string
SetTo(JID) or a JID object. They must be a valid Jabber
Identifiers or the server will return an error message.
(ie. jabber:bob@jabber.org, etc...)
$XDB->SetTo("bob\@jabber.org");
SetFrom(string) - sets the from attribute. You can either pass a string
SetFrom(JID) or a JID object. They must be a valid Jabber
Identifiers or the server will return an error message.
(ie. jabber:bob@jabber.org, etc...)
$XDB->SetFrom("me\@jabber.org");
SetType(string) - sets the type attribute. Valid settings are:
get request information
set set information
result results of a get
error there was an error
$XDB->SetType("set");
SetAction(string) - sets the error code of the .
$XDB->SetAction("foo");
SetMatch(string) - sets the error code of the .
$XDB->SetMatch("foo");
SetErrorCode(string) - sets the error code of the .
$XDB->SetErrorCode(403);
SetError(string) - sets the error string of the .
$XDB->SetError("Permission Denied");
NewData(string) - creates a new Net::Jabber::Data object with the
namespace in the string. In order for this function
to work with a custom namespace, you must define and
register that namespace with the XDB module. For more
information please read the documentation for
Net::Jabber::Data.
$dataObj = $XDB->NewData("jabber:xdb:auth");
$dataObj = $XDB->NewData("jabber:xdb:roster");
Reply(hash) - creates a new XDB object and populates the to/from
fields. If you specify a hash the same as with SetXDB
then those values will override the Reply values.
$xdbReply = $XDB->Reply();
$xdbReply = $XDB->Reply(type=>"result");
=head2 Test functions
DefinedTo() - returns 1 if the to attribute is defined in the ,
0 otherwise.
$test = $XDB->DefinedTo();
DefinedFrom() - returns 1 if the from attribute is defined in the ,
0 otherwise.
$test = $XDB->DefinedFrom();
DefinedID() - returns 1 if the id attribute is defined in the ,
0 otherwise.
$test = $XDB->DefinedID();
DefinedType() - returns 1 if the type attribute is defined in the ,
0 otherwise.
$test = $XDB->DefinedType();
DefinedAction() - returns 1 if the action attribute is defined in the ,
0 otherwise.
$test = $XDB->DefinedAction();
DefinedMatch() - returns 1 if the match attribute is defined in the ,
0 otherwise.
$test = $XDB->DefinedMatch();
DefinedError() - returns 1 if is defined in the ,
0 otherwise.
$test = $XDB->DefinedError();
DefinedErrorCode() - returns 1 if the code attribute is defined in
, 0 otherwise.
$test = $XDB->DefinedErrorCode();
=head1 AUTHOR
By Ryan Eatmon in May of 2001 for http://jabber.org..
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use vars qw($VERSION $AUTOLOAD %FUNCTIONS);
$VERSION = "2.0";
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = { };
$self->{VERSION} = $VERSION;
bless($self, $proto);
$self->{DEBUGHEADER} = "XDB";
$self->{DATA} = {};
$self->{CHILDREN} = {};
$self->{TAG} = "xdb";
if ("@_" ne (""))
{
if (ref($_[0]) eq "Net::Jabber::XDB")
{
return $_[0];
}
else
{
$self->{TREE} = shift;
$self->ParseTree();
}
}
else
{
$self->{TREE} = new XML::Stream::Node($self->{TAG});
}
return $self;
}
##############################################################################
#
# AUTOLOAD - This function calls the main AutoLoad function in Jabber.pm
#
##############################################################################
sub AUTOLOAD
{
my $self = shift;
&Net::Jabber::AutoLoad($self,$AUTOLOAD,@_);
}
$FUNCTIONS{Action}->{Get} = "action";
$FUNCTIONS{Action}->{Set} = ["scalar","action"];
$FUNCTIONS{Action}->{Defined} = "action";
$FUNCTIONS{Action}->{Hash} = "att";
$FUNCTIONS{Action}->{XPath}->{Type} = 'scalar';
$FUNCTIONS{Action}->{XPath}->{Path} = '@action';
$FUNCTIONS{Error}->{Get} = "error";
$FUNCTIONS{Error}->{Set} = ["scalar","error"];
$FUNCTIONS{Error}->{Defined} = "error";
$FUNCTIONS{Error}->{Hash} = "child-data";
$FUNCTIONS{Error}->{XPath}->{Type} = 'scalar';
$FUNCTIONS{Error}->{XPath}->{Path} = 'error/text()';
$FUNCTIONS{ErrorCode}->{Get} = "errorcode";
$FUNCTIONS{ErrorCode}->{Set} = ["scalar","errorcode"];
$FUNCTIONS{ErrorCode}->{Defined} = "errorcode";
$FUNCTIONS{ErrorCode}->{Hash} = "att-error-code";
$FUNCTIONS{ErrorCode}->{XPath}->{Type} = 'scalar';
$FUNCTIONS{ErrorCode}->{XPath}->{Path} = 'error/@code';
$FUNCTIONS{From}->{Get} = "from";
$FUNCTIONS{From}->{Set} = ["jid","from"];
$FUNCTIONS{From}->{Defined} = "from";
$FUNCTIONS{From}->{Hash} = "att";
$FUNCTIONS{From}->{XPath}->{Type} = 'jid';
$FUNCTIONS{From}->{XPath}->{Path} = '@from';
$FUNCTIONS{Match}->{Get} = "match";
$FUNCTIONS{Match}->{Set} = ["scalar","match"];
$FUNCTIONS{Match}->{Defined} = "match";
$FUNCTIONS{Match}->{Hash} = "att";
$FUNCTIONS{Match}->{XPath}->{Type} = 'scalar';
$FUNCTIONS{Match}->{XPath}->{Path} = '@match';
$FUNCTIONS{NS}->{Get} = "ns";
$FUNCTIONS{NS}->{Set} = ["scalar","ns"];
$FUNCTIONS{NS}->{Defined} = "ns";
$FUNCTIONS{NS}->{Hash} = "att";
$FUNCTIONS{NS}->{XPath}->{Type} = 'scalar';
$FUNCTIONS{NS}->{XPath}->{Path} = '@ns';
$FUNCTIONS{ID}->{Get} = "id";
$FUNCTIONS{ID}->{Set} = ["scalar","id"];
$FUNCTIONS{ID}->{Defined} = "id";
$FUNCTIONS{ID}->{Hash} = "att";
$FUNCTIONS{ID}->{XPath}->{Type} = 'scalar';
$FUNCTIONS{ID}->{XPath}->{Path} = '@id';
$FUNCTIONS{To}->{Get} = "to";
$FUNCTIONS{To}->{Set} = ["jid","to"];
$FUNCTIONS{To}->{Defined} = "to";
$FUNCTIONS{To}->{Hash} = "att";
$FUNCTIONS{To}->{XPath}->{Type} = 'jid';
$FUNCTIONS{To}->{XPath}->{Path} = '@to';
$FUNCTIONS{Type}->{Get} = "type";
$FUNCTIONS{Type}->{Set} = ["scalar","type"];
$FUNCTIONS{Type}->{Defined} = "type";
$FUNCTIONS{Type}->{Hash} = "att";
$FUNCTIONS{Type}->{XPath}->{Type} = 'scalar';
$FUNCTIONS{Type}->{XPath}->{Path} = '@type';
$FUNCTIONS{Data}->{Get} = "__netjabber__:children:data";
$FUNCTIONS{Data}->{Defined} = "__netjabber__:children:data";
$FUNCTIONS{Data}->{XPath}->{Type} = 'node';
$FUNCTIONS{Data}->{XPath}->{Path} = '*[@xmlns]';
$FUNCTIONS{X}->{Get} = "__netjabber__:children:x";
$FUNCTIONS{X}->{Defined} = "__netjabber__:children:x";
$FUNCTIONS{X}->{XPath}->{Type} = 'node';
$FUNCTIONS{X}->{XPath}->{Path} = '*[@xmlns]';
$FUNCTIONS{XDB}->{Get} = "__netjabber__:master";
$FUNCTIONS{XDB}->{Set} = ["master"];
##############################################################################
#
# GetDataXMLNS - returns the xmlns of the tag
#
##############################################################################
sub GetDataXMLNS
{
my $self = shift;
#XXX fix this
return $self->{CHILDREN}->{data}->[0]->GetXMLNS() if exists($self->{CHILDREN}->{data});
}
##############################################################################
#
# Reply - returns a Net::Jabber::XDB object with the proper fields
# already populated for you.
#
##############################################################################
sub Reply
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
my $reply = new Net::Jabber::XDB();
$reply->SetID($self->GetID()) if ($self->GetID() ne "");
$reply->SetType("result");
if ($self->DefinedData())
{
my $selfData = $self->GetData();
$reply->NewData($selfData->GetXMLNS());
}
$reply->SetXDB(to=>$self->GetFrom(),
from=>$self->GetTo()
);
$reply->SetXDB(%args);
return $reply;
}
1;
Net-Jabber-2.0/lib/Net/Jabber/Server.pm 0000644 0001750 0001750 00000030153 10110275744 020710 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Jabber
# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################
package Net::Jabber::Server;
=head1 NAME
Net::Jabber::Server - Jabber Server Library
=head1 SYNOPSIS
Net::Jabber::Server is a module that provides a developer easy access
to developing applications that need an embedded Jabber server.
=head1 DESCRIPTION
Server.pm seeks to provide enough high level APIs and automation of
the low level APIs that writing and spawning a Jabber Server in Perl
is trivial. For those that wish to work with the low level you can
do that too, but those functions are covered in the documentation for
each module.
Net::Jabber::Server provides functions to run a full Jabber server that
accepts incoming connections and delivers packets to external Jabber
servers. You can use all or none of the functions, there is no requirement.
For more information on how the details for how Net::Jabber is written
please see the help for Net::Jabber itself.
For a full list of high level functions available please see
Net::Jabber::Protocol.
=head2 Basic Functions
use Net::Jabber qw(Server);
$Server = new Net::Jabber::Server();
$Server->Start();
$Server->Start(jabberxml=>"custom_jabber.xml",
hostname=>"foobar.net");
%status = $Server->Process();
%status = $Server->Process(5);
$Server->Stop();
=head1 METHODS
=head2 Basic Functions
new(debuglevel=>0|1|2, - creates the Server object. debugfile
debugfile=>string, should be set to the path for the debug
debugtime=>0|1) log to be written. If set to "stdout"
then the debug will go there. debuglevel
controls the amount of debug. For more
information about the valid setting for
debuglevel, debugfile, and debugtime see
Net::Jabber::Debug.
Start(hostname=>string, - starts the server listening on the proper
jaberxml=>string) ports. hostname is a quick way of telling
the server the hostname to listen on.
jabberxml defines the path to a different
jabberd configuration file (default is
"./jabber.xml").
Process(integer) - takes the timeout period as an argument. If no
timeout is listed then the function blocks until
a packet is received. Otherwise it waits that
number of seconds and then exits so your program
can continue doing useful things. NOTE: This is
important for GUIs. You need to leave time to
process GUI commands even if you are waiting for
packets. The following are the possible return
values for each hash entry, and what they mean:
1 - Status ok, data received.
0 - Status ok, no data received.
undef - Status not ok, stop processing.
IMPORTANT: You need to check the output of every
Process. If you get an undef then the connection
died and you should behave accordingly.
Stop() - stops the server from running and shuts down all sub programs.
=head1 AUTHOR
By Ryan Eatmon in January of 2001 for http://jabber.org.
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
use strict;
use Carp;
use base qw( Net::Jabber::Protocol );
use vars qw( $VERSION );
$VERSION = "2.0";
use Net::Jabber::Data;
($Net::Jabber::Data::VERSION < $VERSION) &&
die("Net::Jabber::Data $VERSION required--this is only version $Net::Jabber::Data::VERSION");
use Net::Jabber::XDB;
($Net::Jabber::XDB::VERSION < $VERSION) &&
die("Net::Jabber::XDB $VERSION required--this is only version $Net::Jabber::XDB::VERSION");
#use Net::Jabber::Log;
#($Net::Jabber::Log::VERSION < $VERSION) &&
# die("Net::Jabber::Log $VERSION required--this is only version $Net::Jabber::Log::VERSION");
use Net::Jabber::Dialback;
($Net::Jabber::Dialback::VERSION < $VERSION) &&
die("Net::Jabber::Dialback $VERSION required--this is only version $Net::Jabber::Dialback::VERSION");
use Net::Jabber::Key;
($Net::Jabber::Key::VERSION < $VERSION) &&
die("Net::Jabber::Key $VERSION required--this is only version $Net::Jabber::Key::VERSION");
sub new
{
srand( time() ^ ($$ + ($$ << 15)));
my $proto = shift;
my $self = { };
my %args;
while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
bless($self, $proto);
$self->{KEY} = new Net::Jabber::Key();
$self->{DEBUG} =
new Net::Jabber::Debug(level=>exists($args{debuglevel}) ? $args{debuglevel} : -1,
file=>exists($args{debugfile}) ? $args{debugfile} : "stdout",
time=>exists($args{debugtime}) ? $args{debugtime} : 0,
setdefault=>1,
header=>"NJ::Server"
);
$self->{SERVER} = { hostname => "localhost",
port => 5269,
servername => ""};
$self->{STREAM} = new XML::Stream(style=>"node",
debugfh=>$self->{DEBUG}->GetHandle(),
debuglevel=>$self->{DEBUG}->GetLevel(),
debugtime=>$self->{DEBUG}->GetTime());
$self->{STREAM}->SetCallBacks(node=>sub{ $self->CallBack(@_) },
sid=>sub{ return $self->{KEY}->Generate()});
$self->{VERSION} = $VERSION;
return $self;
}
##############################################################################
#
# Start - starts the server running
#
##############################################################################
sub Start
{
my $self = shift;
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
$self->{STOP} = 0;
$self->SetCallBacks('message'=>sub{ $self->messageHandler(@_); },
'presence'=>sub{ $self->presenceHandler(@_); },
'iq'=>sub{ $self->iqHandler(@_); },
'db:result'=>sub{ $self->dbresultHandler(@_); },
'db:verify'=>sub{ $self->dbverifyHandler(@_); },
);
my $hostname = $self->{SERVER}->{hostname};
$hostname = $args{hostname} if exists($args{hostname});
my $status = $self->{STREAM}->Listen(hostname=>$hostname,
port=>$self->{SERVER}->{port},
namespace=>"jabber:server");
while($self->{STOP} == 0) {
while(($self->{STOP} == 0) && defined($self->{STREAM}->Process())) {
}
}
}
###############################################################################
#
# Process - If a timeout value is specified then the function will wait
# that long before returning. This is useful for apps that
# need to handle other processing while still waiting for
# packets. If no timeout is listed then the function waits
# until a packet is returned. Either way the function exits
# as soon as a packet is returned.
#
###############################################################################
sub Process
{
my $self = shift;
my ($timeout) = @_;
my %status;
if (exists($self->{PROCESSERROR}) && ($self->{PROCESSERROR} == 1))
{
croak("You should always check the output of the Process call. If it was undef\nthen there was a fatal error that you need to check. There is an error in your\nprogram.");
}
$self->{DEBUG}->Log1("Process: timeout($timeout)") if defined($timeout);
if (!defined($timeout) || ($timeout eq ""))
{
while(1)
{
%status = $self->{STREAM}->Process();
$self->{DEBUG}->Log1("Process: status($status{$self->{SESSION}->{id}})");
last if ($status{$self->{SESSION}->{id}} != 0);
select(undef,undef,undef,.25);
}
$self->{DEBUG}->Log1("Process: return($status{$self->{SESSION}->{id}})");
if ($status{$self->{SESSION}->{id}} == -1)
{
$self->{PROCESSERROR} = 1;
return;
}
else
{
return $status{$self->{SESSION}->{id}};
}
}
else
{
%status = $self->{STREAM}->Process($timeout);
if ($status{$self->{SESSION}->{id}} == -1)
{
$self->{PROCESSERROR} = 1;
return;
}
else
{
return $status{$self->{SESSION}->{id}};
}
}
}
##############################################################################
#
# Stop - shuts down the server
#
##############################################################################
sub Stop
{
my $self = shift;
$self->{STOP} = 1;
}
sub messageHandler
{
my $self = shift;
my $sid = shift;
my ($message) = @_;
$self->{DEBUG}->Log2("messageHandler: message(",$message->GetXML(),")");
my $reply = $message->Reply();
$self->Send($reply);
}
sub presenceHandler
{
my $self = shift;
my $sid = shift;
my ($presence) = @_;
$self->{DEBUG}->Log2("presenceHandler: presence(",$presence->GetXML(),")");
}
sub iqHandler
{
my $self = shift;
my $sid = shift;
my ($iq) = @_;
$self->{DEBUG}->Log2("iqHandler: iq(",$iq->GetXML(),")");
}
sub dbresultHandler
{
my $self = shift;
my $sid = shift;
my ($dbresult) = @_;
$self->{DEBUG}->Log2("dbresultHandler: dbresult(",$dbresult->GetXML(),")");
my $dbverify = new Net::Jabber::Dialback::Verify();
$dbverify->SetVerify(to=>$dbresult->GetFrom(),
from=>$dbresult->GetTo(),
id=>$self->{STREAM}->GetRoot($sid)->{id},
data=>$dbresult->GetData());
$self->Send($dbverify);
}
sub dbverifyHandler
{
my $self = shift;
my $sid = shift;
my ($dbverify) = @_;
$self->{DEBUG}->Log2("dbverifyHandler: dbverify(",$dbverify->GetXML(),")");
}
sub Send
{
my $self = shift;
my $object = shift;
if (ref($object) eq "")
{
my ($server) = ($object =~ /to=[\"\']([^\"\']+)[\"\']/);
$server =~ s/^\S*\@?(\S+)\/?.*$/$1/;
$self->SendXML($server,$object);
}
else
{
$self->SendXML($object->GetTo("jid")->GetServer(),$object->GetXML());
}
}
sub SendXML {
my $self = shift;
my $server = shift;
my $xml = shift;
$self->{DEBUG}->Log1("SendXML: server($server) sent($xml)");
my $sid = $self->{STREAM}->Host2SID($server);
if (!defined($sid)) {
$self->{STREAM}->Connect(hostname=>$server,
port=>5269,
connectiontype=>"tcpip",
namespace=>"jabber:server");
$sid = $self->{STREAM}->Host2SID($server);
}
$self->{DEBUG}->Log1("SendXML: sid($sid)");
&{$self->{CB}->{send}}($sid,$xml) if exists($self->{CB}->{send});
$self->{STREAM}->Send($sid,$xml);
}
#
# by not send xmlns:db='jabber:server:dialback' to a server, we operate in
# legacy mode, and do not have to do dialback.
#
1;
Net-Jabber-2.0/lib/Net/Jabber/Message.pm 0000644 0001750 0001750 00000003716 10110275744 021033 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::Message;
=head1 NAME
Net::Jabber::Message - Jabber Message Module
=head1 DESCRIPTION
Net::Jabber::Message inherits all of its methods from
Net::XMPP::Message.
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use Net::XMPP::Message;
use base qw( Net::XMPP::Message );
use vars qw( $VERSION );
$VERSION = "2.0";
sub GetX { my $self = shift; $self->GetChild(@_); }
sub DefinedX { my $self = shift; $self->DefinedChild(@_); }
sub NewX { my $self = shift; $self->NewChild(@_); }
sub AddX { my $self = shift; $self->AddChild(@_); }
sub RemoveX { my $self = shift; $self->RemoveChild(@_); }
sub _new_jid { my $self = shift; return new Net::Jabber::JID(@_); }
sub _new_packet { my $self = shift; return new Net::Jabber::Stanza(@_); }
sub _message { my $self = shift; return new Net::Jabber::Message(@_); }
1;
Net-Jabber-2.0/lib/Net/Jabber/Namespaces.pm 0000644 0001750 0001750 00000264204 10110275744 021527 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::Namespaces;
=head1 NAME
Net::Jabber::Namespaces
=head1 SYNOPSIS
Net::Jabber::Namespaces is a pure documentation
module. It provides no code for execution, just
documentation on how the Net::Jabber modules handle
namespaces.
=head1 DESCRIPTION
Net::Jabber::Namespaces is fully documented by Net::XMPP::Namesapces.
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
use Net::XMPP::Namespaces;
$Net::XMPP::Namespaces::SKIPNS{'__netjabber__'} = 1;
#-----------------------------------------------------------------------------
# jabber:iq:agent
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:agent',
tag => 'query',
xpath => {
Agents => {
type => 'flag',
path => 'agents',
},
Description => { path => 'description/text()' },
JID => {
type => 'jid',
path => '@jid',
},
Name => { path => 'name/text()' },
GroupChat => {
type => 'flag',
path => 'groupchat',
},
Register => {
type => 'flag',
path => 'register',
},
Search => {
type => 'flag',
path => 'search',
},
Service => { path => 'service/text()' },
Transport => { path => 'transport/text()' },
URL => { path => 'url/text()' },
Agent => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
deprecated => 1,
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:agents
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:agents',
tag => 'query',
xpath => {
Agent => {
type => 'child',
path => 'agent',
child => {
ns => 'jabber:iq:agent',
skip_xmlns => 1,
},
calls => [ 'Add' ],
},
Agents => {
type => 'child',
path => 'agent',
child => { ns => 'jabber:iq:agent' },
},
},
docs => {
module => 'Net::Jabber',
deprecated => 1,
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:autoupdate
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:autoupdate',
tag => 'query',
xpath => {
Beta => {
type => 'child',
path => 'beta',
child => { ns => '__netjabber__:iq:autoupdate:release' },
calls => [ 'Add' ],
},
Dev => {
type => 'child',
path => 'dev',
child => { ns => '__netjabber__:iq:autoupdate:release' },
calls => [ 'Add' ],
},
Release => {
type => 'child',
path => 'release',
child => { ns => '__netjabber__:iq:autoupdate:release' },
calls => [ 'Add' ],
},
Releases => {
type => 'child',
path => '*',
child => { ns => '__netjabber__:iq:autoupdate:release' },
},
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:autoupdate:release
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:autoupdate:release',
xpath => {
Desc => { path => 'desc/text()' },
Priority => { path => '@priority' },
URL => { path => 'url/text()' },
Version => { path => 'version/text()' },
Release => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:autoupdate - release objects',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:browse
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:browse',
tag => 'item',
xpath => {
Category => { path => '@category' },
Item => {
type => 'child',
path => '*[name() != "ns"]',
child => { ns => '__netjabber__:iq:browse:item',
specify_name => 1,
tag => 'item',
},
calls => [ 'Add' ],
},
Items => {
type => 'child',
path => '*[name() != "ns"]',
child => { ns => '__netjabber__:iq:browse:item' },
},
JID => {
type => 'jid',
path => '@jid',
},
Name => { path => '@name' },
NS => {
type => 'array',
path => 'ns/text()',
},
Type => { path => '@type' },
Browse => { type => 'master' }
},
docs => {
module => 'Net::Jabber',
deprecated => 1,
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:browse:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:browse:item',
tag => 'item',
xpath => {
Category => { path => '@category' },
Item => {
type => 'child',
path => '*[name() != "ns"]',
child => { ns => '__netjabber__:iq:browse:item',
specify_name => 1,
tag => 'item',
},
calls => [ 'Add' ],
},
Items => {
type => 'child',
path => '*[name() != "ns"]',
child => { ns => '__netjabber__:iq:browse:item' },
},
JID => {
type => 'jid',
path => '@jid',
},
Name => { path => '@name' },
NS => {
type => 'array',
path => 'ns/text()',
},
Type => { path => '@type' },
Browse => { type => 'master' }
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:browse - item objects',
deprecated => 1,
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:conference
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:conference',
tag => 'query',
xpath => {
ID => { path => 'id/text()' },
Name => { path => 'name/text()' },
Nick => { path => 'nick/text()' },
Privacy => {
type => 'flag',
path => 'privacy',
},
Secret => { path => 'secret/text()' },
Conference => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:filter
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:filter',
tag => 'query',
xpath => {
Rule => {
type => 'child',
path => 'rule',
child => { ns => '__netjabber__:iq:filter:rule' },
calls => [ 'Add' ],
},
Rules => {
type => 'child',
path => 'rule',
child => { ns => '__netjabber__:iq:filter:rule' },
},
},
docs => {
module => 'Net::Jabber',
deprecated => 1,
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:filter:rule
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:filter:rule',
xpath => {
Body => { path => 'body/text()' },
Continued => { path => 'continued/text()' },
Drop => { path => 'drop/text()' },
Edit => { path => 'edit/text()' },
Error => { path => 'error/text()' },
From => { path => 'from/text()' },
Offline => { path => 'offline/text()' },
Reply => { path => 'reply/text()' },
Resource => { path => 'resource/text()' },
Show => { path => 'show/text()' },
Size => { path => 'size/text()' },
Subject => { path => 'subject/text()' },
Time => { path => 'time/text()' },
Type => { path => 'type/text()' },
Unavailable => { path => 'unavailable/text()' },
Rule => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:filter - rule objects',
deprecated => 1,
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:gateway
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:gateway',
tag => 'query',
xpath => {
Desc => { path => 'desc/text()' },
JID => {
type => 'jid',
path => 'jid/text()',
},
Prompt => { path => 'prompt/text()' },
Gateway => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:last
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:last',
tag => 'query',
xpath => {
Message => { path => 'text()' },
Seconds => { path => '@seconds' },
Last => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:oob
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:oob',
tag => 'query',
xpath => {
Desc => { path => 'desc/text()' },
URL => { path => 'url/text()' },
Oob => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:pass
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:pass',
tag => 'query',
xpath => {
Client => { path => 'client/text()' },
ClientPort => { path => 'client/@port' },
Close => {
type => 'flag',
path => 'close',
},
Expire => { path => 'expire/text()' },
OneShot => {
type => 'flag',
path => 'oneshot',
},
Proxy => { path => 'proxy/text()' },
ProxyPort => { path => 'proxy/@port' },
Server => { path => 'server/text()' },
ServerPort => { path => 'server/@port' },
Pass => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:rpc
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:rpc',
tag => 'query',
xpath => {
MethodCall => {
type => 'child',
path => 'methodCall',
child => { ns => '__netjabber__:iq:rpc:methodCall' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
MethodResponse => {
type => 'child',
path => 'methodResponse',
child => { ns => '__netjabber__:iq:rpc:methodResponse' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:methodCall
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:rpc:methodCall',
xpath => {
MethodName => { path => 'methodName/text()' },
Params => {
type => 'child',
path => 'params',
child => { ns => '__netjabber__:iq:rpc:params' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
MethodCall => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - methodCall objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:methodResponse
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:rpc:methodResponse',
xpath => {
Fault => {
type => 'child',
path => 'fault',
child => { ns => '__netjabber__:iq:rpc:fault' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Params => {
type => 'child',
path => 'params',
child => { ns => '__netjabber__:iq:rpc:params' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - methodResponse objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:fault
#-----------------------------------------------------------------------------
{
&add_ns(ns =>'__netjabber__:iq:rpc:fault',
xpath => {
Value => {
type => 'child',
path => 'value',
child => { ns => '__netjabber__:iq:rpc:value' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - fault objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:params
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:rpc:params',
xpath => {
Param => {
type => 'child',
path => 'param',
child => { ns => '__netjabber__:iq:rpc:param' },
calls => [ 'Add' ],
},
Params => {
type => 'child',
path => 'param',
child => { ns => '__netjabber__:iq:rpc:param' },
},
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - params objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:param
#-----------------------------------------------------------------------------
{
&add_ns(ns =>'__netjabber__:iq:rpc:param',
xpath => {
Value => {
type => 'child',
path => 'value',
child => { ns => '__netjabber__:iq:rpc:value' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - param objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:value
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:rpc:value',
xpath => {
Array => {
type => 'child',
path => 'array',
child => { ns => '__netjabber__:iq:rpc:array' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Base64 => { path => 'base64/text()' },
Boolean => { path => 'boolean/text()' },
DateTime => { path => 'dateTime.iso8601/text()' },
Double => { path => 'double/text()' },
I4 => { path => 'i4/text()' },
Int => { path => 'int/text()' },
String => { path => 'string/text()' },
Struct => {
type => 'child',
path => 'struct',
child => { ns => '__netjabber__:iq:rpc:struct' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Value => { path => 'value/text()' },
RPCValue => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - value objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:struct
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:rpc:struct',
xpath => {
Member => {
type => 'child',
path => 'member',
child => { ns => '__netjabber__:iq:rpc:struct:member' },
calls => [ 'Add' ],
},
Members => {
type => 'child',
path => 'member',
child => { ns => '__netjabber__:iq:rpc:struct:member' },
},
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - struct objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:struct:member
#-----------------------------------------------------------------------------
{
&add_ns(ns =>'__netjabber__:iq:rpc:struct:member',
xpath => {
Name => { path => 'name/text()' },
Value => {
type => 'child',
path => 'value',
child => { ns => '__netjabber__:iq:rpc:value' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Member => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - member objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:array
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:rpc:array',
xpath => {
Data => {
type => 'child',
path => 'data',
child => { ns => '__netjabber__:iq:rpc:array:data' },
calls => [ 'Add' ],
},
Datas => {
type => 'child',
path => 'data',
child => { ns => '__netjabber__:iq:rpc:array:data' },
},
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - array objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:rpc:array:data
#-----------------------------------------------------------------------------
{
&add_ns(ns =>'__netjabber__:iq:rpc:array:data',
xpath => {
Value => {
type => 'child',
path => 'value',
child => { ns => '__netjabber__:iq:rpc:value' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:rpc - data objects',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:search
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:search',
tag => 'query',
xpath => {
Email => { path => 'email/text()' },
Family => { path => 'family/text()' },
First => { path => 'first/text()' },
Given => { path => 'given/text()' },
Instructions => { path => 'instructions/text()' },
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:search:item' },
calls => [ 'Add' ],
},
Items => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:search:item', },
},
Key => { path => 'key/text()' },
Last => { path => 'last/text()' },
Name => { path => 'name/text()' },
Nick => { path => 'nick/text()' },
Truncated => {
type => 'flag',
path => 'truncated',
},
Search => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:search:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:search:item',
xpath => {
Email => { path => 'email/text()' },
Family => { path => 'family/text()' },
First => { path => 'first/text()' },
Given => { path => 'given/text()' },
JID => {
type => 'jid',
path => '@jid',
},
Key => { path => 'key/text()' },
Last => { path => 'last/text()' },
Name => { path => 'name/text()' },
Nick => { path => 'nick/text()' },
Item => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:iq:search - item objects',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:time
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:time',
tag => 'query',
xpath => {
Display => {
type => ['special','time-display'],
path => 'display/text()',
},
TZ => {
type => ['special','time-tz'],
path => 'tz/text()',
},
UTC => {
type => ['special','time-utc'],
path => 'utc/text()',
},
Time => { type => [ 'master', 'all' ] }
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:iq:version
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:iq:version',
tag => 'query',
xpath => {
Name => { path => 'name/text()' },
OS => {
type => [ 'special', 'version-os' ],
path => 'os/text()',
},
Ver => {
type => [ 'special' ,'version-version' ],
path => 'version/text()',
},
Version => { type => [ 'master', 'all' ] }
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:autoupdate
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:autoupdate',
tag => 'x',
xpath => {
JID => {
type => 'jid',
path => '@jid',
},
Autoupdate => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:conference
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:conference',
tag => 'x',
xpath => {
JID => {
type => 'jid',
path => '@jid',
},
Conference => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:data
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:data',
tag => 'x',
xpath => {
Field => {
type => 'child',
path => 'field',
child => { ns => '__netjabber__:x:data:field' },
calls => [ 'Add' ],
},
Fields => {
type => 'child',
path => 'field',
child => { ns => '__netjabber__:x:data:field', },
},
Form => { path => '@form' },
Instructions => { path => 'instructions/text()' },
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:x:data:item' },
calls => [ 'Add' ],
},
Items => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:x:data:item', },
},
Reported => {
type => 'child',
path => 'reported',
child => { ns => '__netjabber__:x:data:reported' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Title => { path => 'title/text()' },
Type => { path => '@type' },
Data => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:x:data:field
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:x:data:field',
xpath => {
Desc => { path => 'desc/text()' },
Label => { path => '@label' },
Option => {
type => 'child',
path => 'option',
child => { ns => '__netjabber__:x:data:field:option' },
calls => [ 'Add' ],
},
Options => {
type => 'child',
path => 'option',
child => { ns => '__netjabber__:x:data:field:option', },
},
Required => {
type => 'flag',
path => 'required',
},
Type => { path => '@type' },
Value => {
type => 'array',
path => 'value/text()',
},
Var => { path => '@var' },
Field => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:x:data - field objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:x:data:field:option
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:x:data:field:option',
xpath => {
Label => { path => '@label' },
Value => { path => 'value/text()' },
Option => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:x:data - option objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:x:data:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:x:data:item',
xpath => {
Field => {
type => 'child',
path => 'field',
child => { ns => '__netjabber__:x:data:field' },
calls => [ 'Add' ],
},
Fields => {
type => 'child',
path => 'field',
child => { ns => '__netjabber__:x:data:field', },
},
Item => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:x:data - item objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:x:data:reported
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:x:data:reported',
xpath => {
Field => {
type => 'child',
path => 'field',
child => { ns => '__netjabber__:x:data:field' },
calls => [ 'Add' ],
},
Fields => {
type => 'child',
path => 'field',
child => { ns => '__netjabber__:x:data:field', },
},
Reported => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:x:data - reported objects',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:delay
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:delay',
tag => 'x',
xpath => {
From => {
type => 'jid',
path => '@from',
},
Message => { path => 'text()' },
Stamp => {
type => 'timestamp',
path => '@stamp',
},
Delay => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:encrypted
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:encrypted',
tag => 'x',
xpath => {
Message => { path => 'text()' },
Encrypted => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:event
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:event',
tag => 'x',
xpath => {
Composing => {
type => 'flag',
path => 'composing',
},
Delivered => {
type => 'flag',
path => 'delivered',
},
Displayed => {
type => 'flag',
path => 'displayed',
},
ID => { path => 'id/text()' },
Offline => {
type => 'flag',
path => 'offline',
},
Event => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:expire
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:expire',
tag => 'x',
xpath => {
Seconds => { path => '@seconds' },
Expire => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:oob
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:oob',
tag => 'x',
xpath => {
Desc => { path => 'desc/text()' },
URL => { path => 'url/text()' },
Oob => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:roster
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:roster',
tag => 'x',
xpath => {
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:x:roster:item' },
calls => [ 'Add' ],
},
Items => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:x:roster:item', },
},
Roster => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:x:roster:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:x:roster:item',
xpath => {
Ask => { path => '@ask' },
Group => {
type => 'array',
path => 'group/text()',
},
JID => {
type => 'jid',
path => '@jid',
},
Name => { path => '@name' },
Subscription => { path => '@subscription' },
Item => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'jabber:x:roster - item objects',
},
);
}
#-----------------------------------------------------------------------------
# jabber:x:signed
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'jabber:x:signed',
tag => 'x',
xpath => {
Signature => { path => 'text()' },
Signed => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/bytestreams
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/bytestreams',
tag => 'query',
xpath => {
Activate => { path => 'activate/text()' },
SID => { path => '@sid' },
StreamHost => {
type => 'child',
path => 'streamhost',
child => { ns => '__netjabber__:iq:bytestreams:streamhost' },
calls => [ 'Add' ],
},
StreamHosts => {
type => 'child',
path => 'streamhost',
child => { ns => '__netjabber__:iq:bytestreams:streamhost', },
},
StreamHostUsedJID => {
type => 'jid',
path => 'streamhost-used/@jid',
},
ByteStreams => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:bytestreams:streamhost
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:bytestreams:streamhost',
xpath => {
Host => { path => '@host' },
JID => {
type => 'jid',
path => '@jid',
},
Port => { path => '@port' },
ZeroConf => { path => '@zeroconf' },
StreamHost => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/bytestreams - streamhost objects',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/commands
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/commands',
tag => 'command',
xpath => {
Action => { path => '@action' },
Node => { path => '@node' },
Note => {
type => 'child',
path => 'note',
child => { ns => '__netjabber__:iq:commands:note' },
calls => [ 'Add' ],
},
Notes => {
type => 'child',
path => 'note',
child => { ns => '__netjabber__:iq:commands:note', },
},
SessionID => { path => '@sessionid' },
Status => { path => '@status' },
Command => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
# xxx xml:lang
#-----------------------------------------------------------------------------
# __netjabber__:iq:commands:note
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:commands:note',
xpath => {
Type => { path => '@type' },
Message => { path => 'text()' },
Note => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/commands - note objects',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/disco#info
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/disco#info',
tag => 'query',
xpath => {
Feature => {
type => 'child',
path => 'feature',
child => { ns => '__netjabber__:iq:disco:info:feature' },
calls => [ 'Add' ],
},
Features => {
type => 'child',
path => 'feature',
child => { ns => '__netjabber__:iq:disco:info:feature' },
},
Identity => {
type => 'child',
path => 'identity',
child => { ns => '__netjabber__:iq:disco:info:identity' },
calls => [ 'Add' ],
},
Identities => {
type => 'child',
path => 'identity',
child => { ns => '__netjabber__:iq:disco:info:identity' },
},
Node => { path => '@node' },
DiscoInfo => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:disco:info:feature
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:disco:info:feature',
xpath => {
Var => { path => '@var' },
Feature => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/disco#info - feature objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:disco:info:identity
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:disco:info:identity',
xpath => {
Category => { path => '@category' },
Name => { path => '@name' },
Type => { path => '@type' },
Identity => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/disco#info - identity objects',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/disco#items
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/disco#items',
tag => 'query',
xpath => {
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:disco:items:item' },
calls => [ 'Add' ],
},
Items => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:disco:items:item' },
},
Node => { path => '@node' },
DiscoItems => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:disco:items:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:disco:items:item',
xpath => {
Action => { path => '@action' },
JID => {
type => 'jid',
path => '@jid',
},
Name => { path => '@name' },
Node => { path => '@node' },
Item => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/disco#items - item objects',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/feature-neg
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/feature-neg',
tag => 'feature',
xpath => {
FeatureNeg => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/muc
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/muc',
tag => 'x',
xpath => {
Password => { path => 'password/text()' },
MUC => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/muc#admin
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/muc#admin',
tag => 'query',
xpath => {
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:muc:admin:item' },
calls => [ 'Add' ],
},
Items => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:muc:admin:item' },
},
Admin => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:muc:admin:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:muc:admin:item',
xpath => {
ActorJID => {
type => 'jid',
path => 'actor/@jid',
},
Affiliation => { path => '@affiliation' },
JID => {
type => 'jid',
path => '@jid',
},
Nick => { path => '@nick' },
Reason => { path => 'reason/text()' },
Role => { path => '@role' },
Item => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/muc#admin - item objects',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/muc#user
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/muc#user',
tag => 'x',
xpath => {
Alt => { path => 'alt/text()' },
Invite => {
type => 'child',
path => 'invite',
child => { ns => '__netjabber__:x:muc:invite' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:x:muc:item' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Password => { path => 'password/text()' },
StatusCode => { path => 'status/@code' },
User => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:x:muc:invite
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:x:muc:invite',
xpath => {
From => {
type => 'jid',
path => '@from',
},
Reason => { path => 'reason/text()' },
To => {
type => 'jid',
path => '@to',
},
Invite => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/muc#user - invite objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:x:muc:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:x:muc:item',
xpath => {
ActorJID => {
type => 'jid',
path => 'actor/@jid',
},
Affiliation => { path => '@affiliation' },
JID => {
type => 'jid',
path => '@jid',
},
Nick => { path => '@nick' },
Reason => { path => 'reason/text()' },
Role => { path => '@role' },
Item => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/muc#user - item objects',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/pubsub
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/pubsub',
tag => 'pubsub',
xpath => {
Affiliations => {
type => 'child',
path => 'affiliations',
child => { ns => '__netjabber__:iq:pubsub:affiliations' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Configure => {
type => 'child',
path => 'configure',
child => { ns => '__netjabber__:iq:pubsub:configure' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Create => {
type => 'child',
path => 'create',
child => { ns => '__netjabber__:iq:pubsub:create' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Delete => {
type => 'child',
path => 'delete',
child => { ns => '__netjabber__:iq:pubsub:delete' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Entities => {
type => 'child',
path => 'entities',
child => { ns => '__netjabber__:iq:pubsub:entities' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Entity => {
type => 'child',
path => 'entity',
child => { ns => '__netjabber__:iq:pubsub:entity' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Items => {
type => 'child',
path => 'items',
child => { ns => '__netjabber__:iq:pubsub:items' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:pubsub:item' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Options => {
type => 'child',
path => 'options',
child => { ns => '__netjabber__:iq:pubsub:options' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Publish => {
type => 'child',
path => 'publish',
child => { ns => '__netjabber__:iq:pubsub:publish' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Purge => {
type => 'child',
path => 'purge',
child => { ns => '__netjabber__:iq:pubsub:purge' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Retract => {
type => 'child',
path => 'retract',
child => { ns => '__netjabber__:iq:pubsub:retract' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Subscribe => {
type => 'child',
path => 'subscribe',
child => { ns => '__netjabber__:iq:pubsub:subscribe' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Unsubscribe => {
type => 'child',
path => 'unsubscribe',
child => { ns => '__netjabber__:iq:pubsub:unsubscribe' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
PubSub => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:affiliations
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:affiliations',
xpath => {
Entity => {
type => 'child',
path => 'entity',
child => { ns => '__netjabber__:iq:pubsub:entity' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Affiliations => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - affiliations objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:configure
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:configure',
xpath => {
Node => { path => '@node' },
Configure => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - configure objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:create
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:create',
xpath => {
Node => { path => '@node' },
Create => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - create objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:delete
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:delete',
xpath => {
Node => { path => '@node' },
Delete => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - delete objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:entities
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:entities',
xpath => {
Entity => {
type => 'child',
path => 'entity',
child => { ns => '__netjabber__:iq:pubsub:entity' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Entities => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - entities objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:entity
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:entity',
xpath => {
Affiliation => { path => '@affiliation' },
JID => {
type => 'jid',
path => '@jid',
},
Node => { path => '@node' },
Subscription => { path => '@subscription' },
SubscribeOptions => {
type => 'child',
path => 'subscribe-options',
child => { ns => '__netjabber__:iq:pubsub:subscribe-options' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Entity => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - entity objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:items
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:items',
xpath => {
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:pubsub:item' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Node => { path => '@node' },
MaxItems => { path => '@max_items' },
Items => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - items objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:item',
xpath => {
ID => { path => '@id' },
Payload => { type => 'raw' },
Item => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - item objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:options
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:options',
xpath => {
JID => {
type => 'jid',
path => '@jid',
},
Node => { path => '@node' },
Options => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - options objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:publish
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:publish',
xpath => {
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:pubsub:item' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Node => { path => '@node' },
Publish => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - publish objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:purge
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:purge',
xpath => {
Node => { path => '@node' },
Purge => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - purge objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:retract
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:retract',
xpath => {
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:pubsub:item' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Node => { path => '@node' },
Retract => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - retract objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:subscribe
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:subscribe',
xpath => {
JID => {
type => 'jid',
path => '@jid',
},
Node => { path => '@node' },
Subscribe => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - subscribe objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:subscribe-options
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:subscribe-options',
xpath => {
Required => {
type => 'flag',
path => 'required',
},
SubscribeOptions => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - subscribe-options objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:unsubscribe
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:unsubscribe',
xpath => {
JID => {
type => 'jid',
path => '@jid',
},
Node => { path => '@node' },
Unsubscribe => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub - unsubscribe objects',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/pubsub#event
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/pubsub#event',
tag => 'event',
xpath => {
Delete => {
type => 'child',
path => 'delete',
child => { ns => '__netjabber__:iq:pubsub:event:delete' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Items => {
type => 'child',
path => 'items',
child => { ns => '__netjabber__:iq:pubsub:event:items' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Event => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:event:delete
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:event:delete',
xpath => {
Node => { path => '@node' },
Delete => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub#event - delete objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:event:items
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:event:items',
xpath => {
Item => {
type => 'child',
path => 'item',
child => { ns => '__netjabber__:iq:pubsub:event:item' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Node => { path => '@node' },
Items => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub#event - items objects',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:event:item
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:event:item',
xpath => {
ID => { path => '@id' },
Payload => { type => 'raw' },
Item => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub#event - item objects',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/pubsub#owner
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/pubsub#owner',
tag => 'pubsub',
xpath => {
Action => { path => '@action' },
Configure => {
type => 'child',
path => 'configure',
child => { ns => '__netjabber__:iq:pubsub:owner:configure' },
calls => [ 'Get', 'Defined', 'Add', 'Remove' ],
},
Owner => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# __netjabber__:iq:pubsub:owner:configure
#-----------------------------------------------------------------------------
{
&add_ns(ns => '__netjabber__:iq:pubsub:owner:configure',
xpath => {
Node => { path => '@node' },
Configure => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
name => 'http://jabber.org/protocol/pubsub#owner - configure objects',
},
);
}
#XXX pubsub#errors
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/si
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/si',
tag => 'si',
xpath => {
ID => { path => '@id' },
MimeType => { path => '@mime-type' },
Profile => { path => '@profile' },
Stream => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/si/profile/file-transfer
#-----------------------------------------------------------------------------
{
&add_ns(ns => 'http://jabber.org/protocol/si/profile/file-transfer',
tag => 'file',
xpath => {
Date => { path => '@date' },
Desc => { path => 'desc/text()' },
Hash => { path => '@hash' },
Name => { path => '@name' },
Range => {
type => 'flag',
path => 'range',
},
RangeOffset => { path => 'range/@offset' },
RangeLength => { path => 'range/@length' },
Size => { path => '@size' },
File => { type => 'master' },
},
docs => {
module => 'Net::Jabber',
},
);
}
#-----------------------------------------------------------------------------
# http://jabber.org/protocol/si/profile/tree-transfer
#-----------------------------------------------------------------------------
# XXX do later
$ns = 'http://jabber.org/protocol/si/profile/tree-transfer';
$TAGS{$ns} = "tree";
$NAMESPACES{$ns}->{Directory}->{XPath}->{Type} = 'child';
$NAMESPACES{$ns}->{Directory}->{XPath}->{Path} = 'directory';
$NAMESPACES{$ns}->{Directory}->{XPath}->{Child} = ['Query','__netjabber__:iq:si:profile:tree:directory'];
$NAMESPACES{$ns}->{Directory}->{XPath}->{Calls} = ['Add','Get'];
$NAMESPACES{$ns}->{Numfiles}->{XPath}->{Path} = '@numfiles';
$NAMESPACES{$ns}->{Size}->{XPath}->{Path} = '@size';
$NAMESPACES{$ns}->{Tree}->{XPath}->{Type} = 'master';
#-----------------------------------------------------------------------------
# __netjabber__:iq:si:profile:tree:directory
#-----------------------------------------------------------------------------
$ns = '__netjabber__:iq:si:profile:tree:directory';
$NAMESPACES{$ns}->{Directory}->{XPath}->{Type} = 'child';
$NAMESPACES{$ns}->{Directory}->{XPath}->{Path} = 'directory';
$NAMESPACES{$ns}->{Directory}->{XPath}->{Child} = ['Query','__netjabber__:iq:si:profile:tree:directory'];
$NAMESPACES{$ns}->{Directory}->{XPath}->{Calls} = ['Add','Get'];
$NAMESPACES{$ns}->{File}->{XPath}->{Type} = 'child';
$NAMESPACES{$ns}->{File}->{XPath}->{Path} = 'file';
$NAMESPACES{$ns}->{File}->{XPath}->{Child} = ['Query','__netjabber__:iq:si:profile:tree:file'];
$NAMESPACES{$ns}->{File}->{XPath}->{Calls} = ['Add','Get'];
$NAMESPACES{$ns}->{Name}->{XPath}->{Path} = '@name';
$NAMESPACES{$ns}->{Dir}->{XPath}->{Type} = 'master';
#-----------------------------------------------------------------------------
# __netjabber__:iq:si:profile:tree:file
#-----------------------------------------------------------------------------
$ns = '__netjabber__:iq:si:profile:tree:file';
$NAMESPACES{$ns}->{Name}->{XPath}->{Path} = '@name';
$NAMESPACES{$ns}->{SID}->{XPath}->{Path} = '@sid';
$NAMESPACES{$ns}->{File}->{XPath}->{Type} = 'master';
sub add_ns
{
&Net::XMPP::Namespaces::add_ns(@_);
}
1;
Net-Jabber-2.0/lib/Net/Jabber/Debug.pm 0000644 0001750 0001750 00000002701 10110275744 020466 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::Debug;
=head1 NAME
Net::Jabber::Debug - Jabber Debug Library
=head1 DESCRIPTION
Net::Jabber::Debug inherits all of its methods from Net::XMPP::Debug.
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use FileHandle;
use Carp;
use Net::XMPP::Debug;
use base qw( Net::XMPP::Debug );
use vars qw( $VERSION );
$VERSION = "2.0";
1;
Net-Jabber-2.0/lib/Net/Jabber/Dialback/ 0002755 0001750 0001750 00000000000 10112242736 020573 5 ustar reatmon reatmon 0000000 0000000 Net-Jabber-2.0/lib/Net/Jabber/Dialback/Result.pm 0000755 0001750 0001750 00000015504 10110275744 022420 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Jabber
# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################
package Net::Jabber::Dialback::Result;
=head1 NAME
Net::Jabber::Dialback::Result - Jabber Dialback Result Module
=head1 SYNOPSIS
Net::Jabber::Dialback::Result is a companion to the Net::Jabber::Dialback
module. It provides the user a simple interface to set and retrieve all
parts of a Jabber Dialback Result.
=head1 DESCRIPTION
To initialize the Result with a Jabber you must pass it
the XML::Stream hash. For example:
my $dialback = new Net::Jabber::Dialback::Result(%hash);
There has been a change from the old way of handling the callbacks.
You no longer have to do the above yourself, a NJ::Dialback::Result
object is passed to the callback function for the message. Also,
the first argument to the callback functions is the session ID from
XML::Streams. There are some cases where you might want this
information, like if you created a Client that connects to two servers
at once, or for writing a mini server.
use Net::Jabber qw(Server);
sub dialbackResult {
my ($sid,$Result) = @_;
.
.
.
}
You now have access to all of the retrieval functions available.
To create a new dialback to send to the server:
use Net::Jabber qw(Server);
$Result = new Net::Jabber::Dialback::Result();
Now you can call the creation functions below to populate the tag before
sending it.
For more information about the array format being passed to the CallBack
please read the Net::Jabber::Client documentation.
=head2 Retrieval functions
$to = $Result->GetTo();
$from = $Result->GetFrom();
$type = $Result->GetType();
$data = $Result->GetData();
$str = $Result->GetXML();
@dialback = $Result->GetTree();
=head2 Creation functions
$Result->SetResult(from=>"jabber.org",
to=>"jabber.com",
data=>key);
$Result->SetTo("jabber.org");
$Result->SetFrom("jabber.com");
$Result->SetType("valid");
$Result->SetData(key);
=head2 Test functions
$test = $Result->DefinedTo();
$test = $Result->DefinedFrom();
$test = $Result->DefinedType();
=head1 METHODS
=head2 Retrieval functions
GetTo() - returns a string with server that the is being
sent to.
GetFrom() - returns a string with server that the is being
sent from.
GetType() - returns a string with the type this is.
GetData() - returns a string with the cdata of the .
GetXML() - returns the XML string that represents the .
This is used by the Send() function in Server.pm to send
this object as a Jabber Dialback Result.
GetTree() - returns an array that contains the tag
in XML::Parser::Tree format.
=head2 Creation functions
SetResult(to=>string, - set multiple fields in the
from=>string, at one time. This is a cumulative
type=>string, and over writing action. If you set
data=>string) the "from" attribute twice, the second
setting is what is used. If you set
the type, and then set the data
then both will be in the
tag. For valid settings read the
specific Set functions below.
SetTo(string) - sets the to attribute.
SetFrom(string) - sets the from attribute.
SetType(string) - sets the type attribute. Valid settings are:
valid
invalid
SetData(string) - sets the cdata of the .
=head2 Test functions
DefinedTo() - returns 1 if the to attribute is defined in the
, 0 otherwise.
DefinedFrom() - returns 1 if the from attribute is defined in the
, 0 otherwise.
DefinedType() - returns 1 if the type attribute is defined in the
, 0 otherwise.
=head1 AUTHOR
By Ryan Eatmon in May of 2001 for http://jabber.org..
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use vars qw($VERSION $AUTOLOAD %FUNCTIONS);
$VERSION = "2.0";
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = { };
$self->{VERSION} = $VERSION;
bless($self, $proto);
$self->{DEBUGHEADER} = "DB:Result";
$self->{DATA} = {};
$self->{CHILDREN} = {};
$self->{TAG} = "db:result";
if ("@_" ne (""))
{
if (ref($_[0]) eq "Net::Jabber::Dialback::Result")
{
return $_[0];
}
else
{
$self->{TREE} = shift;
$self->ParseTree();
}
}
return $self;
}
##############################################################################
#
# AUTOLOAD - This function calls the main AutoLoad function in Jabber.pm
#
##############################################################################
sub AUTOLOAD
{
my $self = shift;
&Net::Jabber::AutoLoad($self,$AUTOLOAD,@_);
}
$FUNCTIONS{From}->{Get} = "from";
$FUNCTIONS{From}->{Set} = ["jid","from"];
$FUNCTIONS{From}->{Defined} = "from";
$FUNCTIONS{From}->{Hash} = "att";
$FUNCTIONS{Data}->{Get} = "data";
$FUNCTIONS{Data}->{Set} = ["scalar","data"];
$FUNCTIONS{Data}->{Defined} = "data";
$FUNCTIONS{Data}->{Hash} = "data";
$FUNCTIONS{To}->{Get} = "to";
$FUNCTIONS{To}->{Set} = ["jid","to"];
$FUNCTIONS{To}->{Defined} = "to";
$FUNCTIONS{To}->{Hash} = "att";
$FUNCTIONS{Type}->{Get} = "type";
$FUNCTIONS{Type}->{Set} = ["scalar","type"];
$FUNCTIONS{Type}->{Defined} = "type";
$FUNCTIONS{Type}->{Hash} = "att";
$FUNCTIONS{Result}->{Get} = "__netjabber__:master";
$FUNCTIONS{Result}->{Set} = ["master"];
1;
Net-Jabber-2.0/lib/Net/Jabber/Dialback/Verify.pm 0000644 0001750 0001750 00000016462 10110275744 022407 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Jabber
# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################
package Net::Jabber::Dialback::Verify;
=head1 NAME
Net::Jabber::Dialback::Verify - Jabber Dialback Verify Module
=head1 SYNOPSIS
Net::Jabber::Dialback::Verify is a companion to the Net::Jabber::Dialback
module. It provides the user a simple interface to set and retrieve all
parts of a Jabber Dialback Verify.
=head1 DESCRIPTION
To initialize the Verify with a Jabber you must pass it
the XML::Stream hash. For example:
my $dialback = new Net::Jabber::Dialback::Verify(%hash);
There has been a change from the old way of handling the callbacks.
You no longer have to do the above yourself, a NJ::Dialback::Verify
object is passed to the callback function for the message. Also,
the first argument to the callback functions is the session ID from
XML::Streams. There are some cases where you might want this
information, like if you created a Client that connects to two servers
at once, or for writing a mini server.
use Net::Jabber qw(Server);
sub dialbackVerify {
my ($sid,$Verify) = @_;
.
.
.
}
You now have access to all of the retrieval functions available.
To create a new dialback to send to the server:
use Net::Jabber qw(Server);
$Verify = new Net::Jabber::Dialback::Verify();
Now you can call the creation functions below to populate the tag before
sending it.
For more information about the array format being passed to the CallBack
please read the Net::Jabber::Client documentation.
=head2 Retrieval functions
$to = $Verify->GetTo();
$from = $Verify->GetFrom();
$type = $Verify->GetType();
$id = $Verify->GetID();
$data = $Verify->GetData();
$str = $Verify->GetXML();
@dialback = $Verify->GetTree();
=head2 Creation functions
$Verify->SetVerify(from=>"jabber.org",
to=>"jabber.com",
id=>id,
data=>key);
$Verify->SetTo("jabber.org");
$Verify->SetFrom("jabber.com");
$Verify->SetType("valid");
$Verify->SetID(id);
$Verify->SetData(key);
=head2 Test functions
$test = $Verify->DefinedTo();
$test = $Verify->DefinedFrom();
$test = $Verify->DefinedType();
$test = $Verify->DefinedID();
=head1 METHODS
=head2 Retrieval functions
GetTo() - returns a string with server that the is being
sent to.
GetFrom() - returns a string with server that the is being
sent from.
GetType() - returns a string with the type this is.
GetID() - returns a string with the id this is.
GetData() - returns a string with the cdata of the .
GetXML() - returns the XML string that represents the .
This is used by the Send() function in Server.pm to send
this object as a Jabber Dialback Verify.
GetTree() - returns an array that contains the tag
in XML::Parser::Tree format.
=head2 Creation functions
SetVerify(to=>string, - set multiple fields in the
from=>string, at one time. This is a cumulative
type=>string, and over writing action. If you set
id=>string, the "from" attribute twice, the second
data=>string) setting is what is used. If you set
the type, and then set the data
then both will be in the
tag. For valid settings read the
specific Set functions below.
SetTo(string) - sets the to attribute.
SetFrom(string) - sets the from attribute.
SetType(string) - sets the type attribute. Valid settings are:
valid
invalid
SetID(string) - sets the id attribute.
SetData(string) - sets the cdata of the .
=head2 Test functions
DefinedTo() - returns 1 if the to attribute is defined in the
, 0 otherwise.
DefinedFrom() - returns 1 if the from attribute is defined in the
, 0 otherwise.
DefinedType() - returns 1 if the type attribute is defined in the
, 0 otherwise.
DefinedID() - returns 1 if the id attribute is defined in the
, 0 otherwise.
=head1 AUTHOR
By Ryan Eatmon in May of 2001 for http://jabber.org..
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use vars qw($VERSION $AUTOLOAD %FUNCTIONS);
$VERSION = "2.0";
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = { };
$self->{VERSION} = $VERSION;
bless($self, $proto);
$self->{DEBUGHEADER} = "DB:Verify";
$self->{DATA} = {};
$self->{CHILDREN} = {};
$self->{TAG} = "db:verify";
if ("@_" ne (""))
{
if (ref($_[0]) eq "Net::Jabber::Dialback::Verify")
{
return $_[0];
}
else
{
$self->{TREE} = shift;
$self->ParseTree();
}
}
return $self;
}
##############################################################################
#
# AUTOLOAD - This function calls the main AutoLoad function in Jabber.pm
#
##############################################################################
sub AUTOLOAD
{
my $self = shift;
&Net::Jabber::AutoLoad($self,$AUTOLOAD,@_);
}
$FUNCTIONS{From}->{Get} = "from";
$FUNCTIONS{From}->{Set} = ["jid","from"];
$FUNCTIONS{From}->{Defined} = "from";
$FUNCTIONS{From}->{Hash} = "att";
$FUNCTIONS{Data}->{Get} = "data";
$FUNCTIONS{Data}->{Set} = ["scalar","data"];
$FUNCTIONS{Data}->{Defined} = "data";
$FUNCTIONS{Data}->{Hash} = "data";
$FUNCTIONS{ID}->{Get} = "id";
$FUNCTIONS{ID}->{Set} = ["scalar","id"];
$FUNCTIONS{ID}->{Defined} = "id";
$FUNCTIONS{ID}->{Hash} = "child-data";
$FUNCTIONS{To}->{Get} = "to";
$FUNCTIONS{To}->{Set} = ["jid","to"];
$FUNCTIONS{To}->{Defined} = "to";
$FUNCTIONS{To}->{Hash} = "att";
$FUNCTIONS{Type}->{Get} = "type";
$FUNCTIONS{Type}->{Set} = ["scalar","type"];
$FUNCTIONS{Type}->{Defined} = "type";
$FUNCTIONS{Type}->{Hash} = "att";
$FUNCTIONS{Verify}->{Get} = "__netjabber__:master";
$FUNCTIONS{Verify}->{Set} = ["master"];
1;
Net-Jabber-2.0/lib/Net/Jabber/JID.pm 0000644 0001750 0001750 00000002642 10110275744 020052 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::JID;
=head1 NAME
Net::Jabber::JID - Jabber JID Module
=head1 DESCRIPTION
Net::Jabber::JID inherits all of its methods from Net::XMPP::JID.
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use Net::XMPP::JID;
use base qw( Net::XMPP::JID );
use vars qw($VERSION);
$VERSION = "2.0";
1;
Net-Jabber-2.0/lib/Net/Jabber/Client.pm 0000644 0001750 0001750 00000004656 10110275744 020671 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::Client;
=head1 NAME
Net::Jabber::Client - Jabber Client Library
=head1 SYNOPSIS
Net::Jabber::Client is a module that provides a developer easy access
to the Jabber Instant Messaging protocol.
=head1 DESCRIPTION
Client.pm inherits its methods from Net::XMPP::Client,
Net::XMPP::Protocol and Net::Jabber::Protocol. The Protocol modules
provide enough high level APIs and automation of the low level APIs
that writing a Jabber Client in Perl is trivial. For those that wish
to work with the low level you can do that too, but those functions are
covered in the documentation for each module.
Net::Jabber::Client provides functions to connect to a Jabber server,
login, send and receive messages, set personal information, create a
new user account, manage the roster, and disconnect. You can use all
or none of the functions, there is no requirement.
For more information on how the details for how Net::Jabber is written
please see the help for Net::Jabber itself.
For a full list of high level functions available please see:
Net::XMPP::Client
Net::XMPP::Protocol
Net::Jabber::Protocol
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
use strict;
use Carp;
use Net::XMPP::Client;
use Net::Jabber::Protocol;
use base qw( Net::XMPP::Client Net::Jabber::Protocol );
use vars qw( $VERSION );
$VERSION = "2.0";
1;
Net-Jabber-2.0/lib/Net/Jabber/Stanza.pm 0000644 0001750 0001750 00000260742 10110301423 020673 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::Stanza;
=head1 NAME
Net::Jabber::Stanza - Jabber Stanza Module
=head1 SYNOPSIS
Net::Jabber::Stanza is a private package that serves as a basis
for all Jabber stanzas generated by Net::Jabber.
=head1 DESCRIPTION
This module is not meant to be used directly. You should be using
either Net::Jabber::IQ, Net::Jabber::Message, Net::Jabber::Presence, or
another package that inherits from Net::Jabber::Stanza.
That said, this is where all of the namespaced methods are defined.
The current supported namespaces are:
=cut
# NS_BEGIN
=pod
http://jabber.org/protocol/bytestreams
http://jabber.org/protocol/commands
http://jabber.org/protocol/disco#info
http://jabber.org/protocol/disco#items
http://jabber.org/protocol/feature-neg
http://jabber.org/protocol/muc
http://jabber.org/protocol/muc#admin
http://jabber.org/protocol/muc#user
http://jabber.org/protocol/pubsub
http://jabber.org/protocol/pubsub#event
http://jabber.org/protocol/pubsub#owner
http://jabber.org/protocol/si
http://jabber.org/protocol/si/profile/file-transfer
jabber:iq:agent - DEPRECATED
jabber:iq:agents - DEPRECATED
jabber:iq:autoupdate
jabber:iq:browse - DEPRECATED
jabber:iq:conference
jabber:iq:filter - DEPRECATED
jabber:iq:gateway
jabber:iq:last
jabber:iq:oob
jabber:iq:pass
jabber:iq:rpc
jabber:iq:search
jabber:iq:time
jabber:iq:version
jabber:x:autoupdate
jabber:x:conference
jabber:x:data
jabber:x:delay
jabber:x:encrypted
jabber:x:event
jabber:x:expire
jabber:x:oob
jabber:x:roster
jabber:x:signed
=cut
# NS_END
=pod
For more information on what these namespaces are for, visit
http://www.jabber.org and browse the Jabber Programmers Guide.
The following tables can be read as follows:
ny:private:ns
Name Type Get Set Remove Defined Add
========================== ======= === === ====== ======= ===
Foo scalar X X X X
Bar child X
Bars child X
Test master X X
Withing the my:private:ns namespace, there exists the functions:
GetFoo(), SetFoo(), RemoveFoo(), DefinedFoo()
AddBar()
GetBars(), DefinedBars()
GetTest(), SetMaster()
Hopefully it should be obvious how this all works. If not feel free to
contact me and I'll work on adding more documentation.
=cut
# DOC_BEGIN
=head1 http://jabber.org/protocol/bytestreams
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Activate scalar X X X X
SID scalar X X X X
StreamHostUsedJID jid X X X X
StreamHost child X
StreamHosts child X X X
ByteStreams master X X
=head1 http://jabber.org/protocol/bytestreams - streamhost objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Host scalar X X X X
JID jid X X X X
Port scalar X X X X
ZeroConf scalar X X X X
StreamHost master X X
=head1 http://jabber.org/protocol/commands
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Action scalar X X X X
Node scalar X X X X
SessionID scalar X X X X
Status scalar X X X X
Note child X
Notes child X X X
Command master X X
=head1 http://jabber.org/protocol/commands - note objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Message scalar X X X X
Type scalar X X X X
Note master X X
=head1 http://jabber.org/protocol/disco#info
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Feature child X
Features child X X X
Identities child X X X
Identity child X
DiscoInfo master X X
=head1 http://jabber.org/protocol/disco#info - feature objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Var scalar X X X X
Feature master X X
=head1 http://jabber.org/protocol/disco#info - identity objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Category scalar X X X X
Name scalar X X X X
Type scalar X X X X
Identity master X X
=head1 http://jabber.org/protocol/disco#items
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Item child X
Items child X X X
DiscoItems master X X
=head1 http://jabber.org/protocol/disco#items - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Action scalar X X X X
JID jid X X X X
Name scalar X X X X
Node scalar X X X X
Item master X X
=head1 http://jabber.org/protocol/feature-neg
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
FeatureNeg master X X
=head1 http://jabber.org/protocol/muc
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Password scalar X X X X
MUC master X X
=head1 http://jabber.org/protocol/muc#admin
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Item child X
Items child X X X
Admin master X X
=head1 http://jabber.org/protocol/muc#admin - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ActorJID jid X X X X
Affiliation scalar X X X X
JID jid X X X X
Nick scalar X X X X
Reason scalar X X X X
Role scalar X X X X
Item master X X
=head1 http://jabber.org/protocol/muc#user
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Alt scalar X X X X
Password scalar X X X X
StatusCode scalar X X X X
Invite child X X X X
Item child X X X X
User master X X
=head1 http://jabber.org/protocol/muc#user - invite objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
From jid X X X X
Reason scalar X X X X
To jid X X X X
Invite master X X
=head1 http://jabber.org/protocol/muc#user - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ActorJID jid X X X X
Affiliation scalar X X X X
JID jid X X X X
Nick scalar X X X X
Reason scalar X X X X
Role scalar X X X X
Item master X X
=head1 http://jabber.org/protocol/pubsub
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Affiliations child X X X X
Configure child X X X X
Create child X X X X
Delete child X X X X
Entities child X X X X
Entity child X X X X
Item child X X X X
Items child X X X X
Options child X X X X
Publish child X X X X
Purge child X X X X
Retract child X X X X
Subscribe child X X X X
Unsubscribe child X X X X
PubSub master X X
=head1 http://jabber.org/protocol/pubsub - affiliations objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Entity child X X X X
Affiliations master X X
=head1 http://jabber.org/protocol/pubsub - configure objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Configure master X X
=head1 http://jabber.org/protocol/pubsub - create objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Create master X X
=head1 http://jabber.org/protocol/pubsub - delete objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Delete master X X
=head1 http://jabber.org/protocol/pubsub - entities objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Entity child X X X X
Entities master X X
=head1 http://jabber.org/protocol/pubsub - entity objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Affiliation scalar X X X X
JID jid X X X X
Node scalar X X X X
Subscription scalar X X X X
SubscribeOptions child X X X X
Entity master X X
=head1 http://jabber.org/protocol/pubsub - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ID scalar X X X X
Payload raw X X X X
Item master X X
=head1 http://jabber.org/protocol/pubsub - items objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
MaxItems scalar X X X X
Node scalar X X X X
Item child X X X X
Items master X X
=head1 http://jabber.org/protocol/pubsub - options objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Node scalar X X X X
Options master X X
=head1 http://jabber.org/protocol/pubsub - publish objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Item child X X X X
Publish master X X
=head1 http://jabber.org/protocol/pubsub - purge objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Purge master X X
=head1 http://jabber.org/protocol/pubsub - retract objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Item child X X X X
Retract master X X
=head1 http://jabber.org/protocol/pubsub - subscribe objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Node scalar X X X X
Subscribe master X X
=head1 http://jabber.org/protocol/pubsub - subscribe-options objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Required flag X X X X
SubscribeOptions master X X
=head1 http://jabber.org/protocol/pubsub - unsubscribe objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Node scalar X X X X
Unsubscribe master X X
=head1 http://jabber.org/protocol/pubsub#event
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Delete child X X X X
Items child X X X X
Event master X X
=head1 http://jabber.org/protocol/pubsub#event - delete objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Delete master X X
=head1 http://jabber.org/protocol/pubsub#event - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ID scalar X X X X
Payload raw X X X X
Item master X X
=head1 http://jabber.org/protocol/pubsub#event - items objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Item child X X X X
Items master X X
=head1 http://jabber.org/protocol/pubsub#owner
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Action scalar X X X X
Configure child X X X X
Owner master X X
=head1 http://jabber.org/protocol/pubsub#owner - configure objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Configure master X X
=head1 http://jabber.org/protocol/si
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ID scalar X X X X
MimeType scalar X X X X
Profile scalar X X X X
Stream master X X
=head1 http://jabber.org/protocol/si/profile/file-transfer
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Date scalar X X X X
Desc scalar X X X X
Hash scalar X X X X
Name scalar X X X X
Range flag X X X X
RangeLength scalar X X X X
RangeOffset scalar X X X X
Size scalar X X X X
File master X X
=head1 jabber:iq:agent - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Agents flag X X X X
Description scalar X X X X
GroupChat flag X X X X
JID jid X X X X
Name scalar X X X X
Register flag X X X X
Search flag X X X X
Service scalar X X X X
Transport scalar X X X X
URL scalar X X X X
Agent master X X
=head1 jabber:iq:agents - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Agent child X
Agents child X X X
=head1 jabber:iq:autoupdate
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Beta child X
Dev child X
Release child X
Releases child X X X
=head1 jabber:iq:autoupdate - release objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
Priority scalar X X X X
URL scalar X X X X
Version scalar X X X X
Release master X X
=head1 jabber:iq:browse - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Category scalar X X X X
JID jid X X X X
NS array X X X X
Name scalar X X X X
Type scalar X X X X
Item child X
Items child X X X
Browse master X X
=head1 jabber:iq:browse - item objects - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Category scalar X X X X
JID jid X X X X
NS array X X X X
Name scalar X X X X
Type scalar X X X X
Item child X
Items child X X X
Browse master X X
=head1 jabber:iq:conference
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ID scalar X X X X
Name scalar X X X X
Nick scalar X X X X
Privacy flag X X X X
Secret scalar X X X X
Conference master X X
=head1 jabber:iq:filter - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Rule child X
Rules child X X X
=head1 jabber:iq:filter - rule objects - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Body scalar X X X X
Continued scalar X X X X
Drop scalar X X X X
Edit scalar X X X X
Error scalar X X X X
From scalar X X X X
Offline scalar X X X X
Reply scalar X X X X
Resource scalar X X X X
Show scalar X X X X
Size scalar X X X X
Subject scalar X X X X
Time scalar X X X X
Type scalar X X X X
Unavailable scalar X X X X
Rule master X X
=head1 jabber:iq:gateway
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
JID jid X X X X
Prompt scalar X X X X
Gateway master X X
=head1 jabber:iq:last
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Message scalar X X X X
Seconds scalar X X X X
Last master X X
=head1 jabber:iq:oob
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
URL scalar X X X X
Oob master X X
=head1 jabber:iq:pass
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Client scalar X X X X
ClientPort scalar X X X X
Close flag X X X X
Expire scalar X X X X
OneShot flag X X X X
Proxy scalar X X X X
ProxyPort scalar X X X X
Server scalar X X X X
ServerPort scalar X X X X
Pass master X X
=head1 jabber:iq:rpc
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
MethodCall child X X X X
MethodResponse child X X X X
=head1 jabber:iq:rpc - array objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Data child X
Datas child X X X
=head1 jabber:iq:rpc - data objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Value child X X X X
=head1 jabber:iq:rpc - fault objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Value child X X X X
=head1 jabber:iq:rpc - member objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Name scalar X X X X
Value child X X X X
Member master X X
=head1 jabber:iq:rpc - methodCall objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
MethodName scalar X X X X
Params child X X X X
MethodCall master X X
=head1 jabber:iq:rpc - methodResponse objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Fault child X X X X
Params child X X X X
=head1 jabber:iq:rpc - param objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Value child X X X X
=head1 jabber:iq:rpc - params objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Param child X
Params child X X X
=head1 jabber:iq:rpc - struct objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Member child X
Members child X X X
=head1 jabber:iq:rpc - value objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Base64 scalar X X X X
Boolean scalar X X X X
DateTime scalar X X X X
Double scalar X X X X
I4 scalar X X X X
Int scalar X X X X
String scalar X X X X
Value scalar X X X X
Array child X X X X
Struct child X X X X
RPCValue master X X
=head1 jabber:iq:search
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Email scalar X X X X
Family scalar X X X X
First scalar X X X X
Given scalar X X X X
Instructions scalar X X X X
Key scalar X X X X
Last scalar X X X X
Name scalar X X X X
Nick scalar X X X X
Truncated flag X X X X
Item child X
Items child X X X
Search master X X
=head1 jabber:iq:search - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Email scalar X X X X
Family scalar X X X X
First scalar X X X X
Given scalar X X X X
JID jid X X X X
Key scalar X X X X
Last scalar X X X X
Name scalar X X X X
Nick scalar X X X X
Item master X X
=head1 jabber:iq:time
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Display special X X X X
TZ special X X X X
UTC special X X X X
Time master X X
=head1 jabber:iq:version
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Name scalar X X X X
OS special X X X X
Ver special X X X X
Version master X X
=head1 jabber:x:autoupdate
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Autoupdate master X X
=head1 jabber:x:conference
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Conference master X X
=head1 jabber:x:data
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Form scalar X X X X
Instructions scalar X X X X
Title scalar X X X X
Type scalar X X X X
Field child X
Fields child X X X
Item child X
Items child X X X
Reported child X X X X
Data master X X
=head1 jabber:x:data - field objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
Label scalar X X X X
Required flag X X X X
Type scalar X X X X
Value array X X X X
Var scalar X X X X
Option child X
Options child X X X
Field master X X
=head1 jabber:x:data - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Field child X
Fields child X X X
Item master X X
=head1 jabber:x:data - option objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Label scalar X X X X
Value scalar X X X X
Option master X X
=head1 jabber:x:data - reported objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Field child X
Fields child X X X
Reported master X X
=head1 jabber:x:delay
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
From jid X X X X
Message scalar X X X X
Stamp timestamp X X X X
Delay master X X
=head1 jabber:x:encrypted
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Message scalar X X X X
Encrypted master X X
=head1 jabber:x:event
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Composing flag X X X X
Delivered flag X X X X
Displayed flag X X X X
ID scalar X X X X
Offline flag X X X X
Event master X X
=head1 jabber:x:expire
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Seconds scalar X X X X
Expire master X X
=head1 jabber:x:oob
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
URL scalar X X X X
Oob master X X
=head1 jabber:x:roster
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Item child X
Items child X X X
Roster master X X
=head1 jabber:x:roster - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Ask scalar X X X X
Group array X X X X
JID jid X X X X
Name scalar X X X X
Subscription scalar X X X X
Item master X X
=head1 jabber:x:signed
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Signature scalar X X X X
Signed master X X
# DOC_BEGIN
=head1 http://jabber.org/protocol/bytestreams
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Activate scalar X X X X
SID scalar X X X X
StreamHostUsedJID jid X X X X
StreamHost child X
StreamHosts child X X X
ByteStreams master X X
=head1 http://jabber.org/protocol/bytestreams - streamhost objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Host scalar X X X X
JID jid X X X X
Port scalar X X X X
ZeroConf scalar X X X X
StreamHost master X X
=head1 http://jabber.org/protocol/commands
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Action scalar X X X X
Node scalar X X X X
SessionID scalar X X X X
Status scalar X X X X
Note child X
Notes child X X X
Command master X X
=head1 http://jabber.org/protocol/commands - note objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Message scalar X X X X
Type scalar X X X X
Note master X X
=head1 http://jabber.org/protocol/disco#info
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Feature child X
Features child X X X
Identities child X X X
Identity child X
DiscoInfo master X X
=head1 http://jabber.org/protocol/disco#info - feature objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Var scalar X X X X
Feature master X X
=head1 http://jabber.org/protocol/disco#info - identity objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Category scalar X X X X
Name scalar X X X X
Type scalar X X X X
Identity master X X
=head1 http://jabber.org/protocol/disco#items
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Item child X
Items child X X X
DiscoItems master X X
=head1 http://jabber.org/protocol/disco#items - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Action scalar X X X X
JID jid X X X X
Name scalar X X X X
Node scalar X X X X
Item master X X
=head1 http://jabber.org/protocol/feature-neg
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
FeatureNeg master X X
=head1 http://jabber.org/protocol/muc
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Password scalar X X X X
MUC master X X
=head1 http://jabber.org/protocol/muc#admin
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Item child X
Items child X X X
Admin master X X
=head1 http://jabber.org/protocol/muc#admin - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ActorJID jid X X X X
Affiliation scalar X X X X
JID jid X X X X
Nick scalar X X X X
Reason scalar X X X X
Role scalar X X X X
Item master X X
=head1 http://jabber.org/protocol/muc#user
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Alt scalar X X X X
Password scalar X X X X
StatusCode scalar X X X X
Invite child X X X X
Item child X X X X
User master X X
=head1 http://jabber.org/protocol/muc#user - invite objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
From jid X X X X
Reason scalar X X X X
To jid X X X X
Invite master X X
=head1 http://jabber.org/protocol/muc#user - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ActorJID jid X X X X
Affiliation scalar X X X X
JID jid X X X X
Nick scalar X X X X
Reason scalar X X X X
Role scalar X X X X
Item master X X
=head1 http://jabber.org/protocol/pubsub
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Affiliations child X X X X
Configure child X X X X
Create child X X X X
Delete child X X X X
Entities child X X X X
Entity child X X X X
Item child X X X X
Items child X X X X
Options child X X X X
Publish child X X X X
Purge child X X X X
Retract child X X X X
Subscribe child X X X X
Unsubscribe child X X X X
PubSub master X X
=head1 http://jabber.org/protocol/pubsub - affiliations objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Entity child X X X X
Affiliations master X X
=head1 http://jabber.org/protocol/pubsub - configure objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Configure master X X
=head1 http://jabber.org/protocol/pubsub - create objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Create master X X
=head1 http://jabber.org/protocol/pubsub - delete objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Delete master X X
=head1 http://jabber.org/protocol/pubsub - entities objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Entity child X X X X
Entities master X X
=head1 http://jabber.org/protocol/pubsub - entity objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Affiliation scalar X X X X
JID jid X X X X
Node scalar X X X X
Subscription scalar X X X X
SubscribeOptions child X X X X
Entity master X X
=head1 http://jabber.org/protocol/pubsub - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ID scalar X X X X
Payload raw X X X X
Item master X X
=head1 http://jabber.org/protocol/pubsub - items objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
MaxItems scalar X X X X
Node scalar X X X X
Item child X X X X
Items master X X
=head1 http://jabber.org/protocol/pubsub - options objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Node scalar X X X X
Options master X X
=head1 http://jabber.org/protocol/pubsub - publish objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Item child X X X X
Publish master X X
=head1 http://jabber.org/protocol/pubsub - purge objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Purge master X X
=head1 http://jabber.org/protocol/pubsub - retract objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Item child X X X X
Retract master X X
=head1 http://jabber.org/protocol/pubsub - subscribe objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Node scalar X X X X
Subscribe master X X
=head1 http://jabber.org/protocol/pubsub - subscribe-options objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Required flag X X X X
SubscribeOptions master X X
=head1 http://jabber.org/protocol/pubsub - unsubscribe objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Node scalar X X X X
Unsubscribe master X X
=head1 http://jabber.org/protocol/pubsub#event
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Delete child X X X X
Items child X X X X
Event master X X
=head1 http://jabber.org/protocol/pubsub#event - delete objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Delete master X X
=head1 http://jabber.org/protocol/pubsub#event - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ID scalar X X X X
Payload raw X X X X
Item master X X
=head1 http://jabber.org/protocol/pubsub#event - items objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Item child X X X X
Items master X X
=head1 http://jabber.org/protocol/pubsub#owner
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Action scalar X X X X
Configure child X X X X
Owner master X X
=head1 http://jabber.org/protocol/pubsub#owner - configure objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Node scalar X X X X
Configure master X X
=head1 http://jabber.org/protocol/si
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ID scalar X X X X
MimeType scalar X X X X
Profile scalar X X X X
Stream master X X
=head1 http://jabber.org/protocol/si/profile/file-transfer
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Date scalar X X X X
Desc scalar X X X X
Hash scalar X X X X
Name scalar X X X X
Range flag X X X X
RangeLength scalar X X X X
RangeOffset scalar X X X X
Size scalar X X X X
File master X X
=head1 jabber:iq:agent - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Agents flag X X X X
Description scalar X X X X
GroupChat flag X X X X
JID jid X X X X
Name scalar X X X X
Register flag X X X X
Search flag X X X X
Service scalar X X X X
Transport scalar X X X X
URL scalar X X X X
Agent master X X
=head1 jabber:iq:agents - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Agent child X
Agents child X X X
=head1 jabber:iq:autoupdate
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Beta child X
Dev child X
Release child X
Releases child X X X
=head1 jabber:iq:autoupdate - release objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
Priority scalar X X X X
URL scalar X X X X
Version scalar X X X X
Release master X X
=head1 jabber:iq:browse - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Category scalar X X X X
JID jid X X X X
NS array X X X X
Name scalar X X X X
Type scalar X X X X
Item child X
Items child X X X
Browse master X X
=head1 jabber:iq:browse - item objects - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Category scalar X X X X
JID jid X X X X
NS array X X X X
Name scalar X X X X
Type scalar X X X X
Item child X
Items child X X X
Browse master X X
=head1 jabber:iq:conference
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
ID scalar X X X X
Name scalar X X X X
Nick scalar X X X X
Privacy flag X X X X
Secret scalar X X X X
Conference master X X
=head1 jabber:iq:filter - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Rule child X
Rules child X X X
=head1 jabber:iq:filter - rule objects - DEPRECATED
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Body scalar X X X X
Continued scalar X X X X
Drop scalar X X X X
Edit scalar X X X X
Error scalar X X X X
From scalar X X X X
Offline scalar X X X X
Reply scalar X X X X
Resource scalar X X X X
Show scalar X X X X
Size scalar X X X X
Subject scalar X X X X
Time scalar X X X X
Type scalar X X X X
Unavailable scalar X X X X
Rule master X X
=head1 jabber:iq:gateway
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
JID jid X X X X
Prompt scalar X X X X
Gateway master X X
=head1 jabber:iq:last
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Message scalar X X X X
Seconds scalar X X X X
Last master X X
=head1 jabber:iq:oob
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
URL scalar X X X X
Oob master X X
=head1 jabber:iq:pass
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Client scalar X X X X
ClientPort scalar X X X X
Close flag X X X X
Expire scalar X X X X
OneShot flag X X X X
Proxy scalar X X X X
ProxyPort scalar X X X X
Server scalar X X X X
ServerPort scalar X X X X
Pass master X X
=head1 jabber:iq:rpc
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
MethodCall child X X X X
MethodResponse child X X X X
=head1 jabber:iq:rpc - array objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Data child X
Datas child X X X
=head1 jabber:iq:rpc - data objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Value child X X X X
=head1 jabber:iq:rpc - fault objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Value child X X X X
=head1 jabber:iq:rpc - member objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Name scalar X X X X
Value child X X X X
Member master X X
=head1 jabber:iq:rpc - methodCall objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
MethodName scalar X X X X
Params child X X X X
MethodCall master X X
=head1 jabber:iq:rpc - methodResponse objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Fault child X X X X
Params child X X X X
=head1 jabber:iq:rpc - param objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Value child X X X X
=head1 jabber:iq:rpc - params objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Param child X
Params child X X X
=head1 jabber:iq:rpc - struct objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Member child X
Members child X X X
=head1 jabber:iq:rpc - value objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Base64 scalar X X X X
Boolean scalar X X X X
DateTime scalar X X X X
Double scalar X X X X
I4 scalar X X X X
Int scalar X X X X
String scalar X X X X
Value scalar X X X X
Array child X X X X
Struct child X X X X
RPCValue master X X
=head1 jabber:iq:search
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Email scalar X X X X
Family scalar X X X X
First scalar X X X X
Given scalar X X X X
Instructions scalar X X X X
Key scalar X X X X
Last scalar X X X X
Name scalar X X X X
Nick scalar X X X X
Truncated flag X X X X
Item child X
Items child X X X
Search master X X
=head1 jabber:iq:search - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Email scalar X X X X
Family scalar X X X X
First scalar X X X X
Given scalar X X X X
JID jid X X X X
Key scalar X X X X
Last scalar X X X X
Name scalar X X X X
Nick scalar X X X X
Item master X X
=head1 jabber:iq:time
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Display special X X X X
TZ special X X X X
UTC special X X X X
Time master X X
=head1 jabber:iq:version
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Name scalar X X X X
OS special X X X X
Ver special X X X X
Version master X X
=head1 jabber:x:autoupdate
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Autoupdate master X X
=head1 jabber:x:conference
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
JID jid X X X X
Conference master X X
=head1 jabber:x:data
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Form scalar X X X X
Instructions scalar X X X X
Title scalar X X X X
Type scalar X X X X
Field child X
Fields child X X X
Item child X
Items child X X X
Reported child X X X X
Data master X X
=head1 jabber:x:data - field objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
Label scalar X X X X
Required flag X X X X
Type scalar X X X X
Value array X X X X
Var scalar X X X X
Option child X
Options child X X X
Field master X X
=head1 jabber:x:data - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Field child X
Fields child X X X
Item master X X
=head1 jabber:x:data - option objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Label scalar X X X X
Value scalar X X X X
Option master X X
=head1 jabber:x:data - reported objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Field child X
Fields child X X X
Reported master X X
=head1 jabber:x:delay
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
From jid X X X X
Message scalar X X X X
Stamp timestamp X X X X
Delay master X X
=head1 jabber:x:encrypted
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Message scalar X X X X
Encrypted master X X
=head1 jabber:x:event
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Composing flag X X X X
Delivered flag X X X X
Displayed flag X X X X
ID scalar X X X X
Offline flag X X X X
Event master X X
=head1 jabber:x:expire
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Seconds scalar X X X X
Expire master X X
=head1 jabber:x:oob
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Desc scalar X X X X
URL scalar X X X X
Oob master X X
=head1 jabber:x:roster
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Item child X
Items child X X X
Roster master X X
=head1 jabber:x:roster - item objects
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Ask scalar X X X X
Group array X X X X
JID jid X X X X
Name scalar X X X X
Subscription scalar X X X X
Item master X X
=head1 jabber:x:signed
Name Type Get Set Remove Defined Add
========================== ========= === === ====== ======= ===
Signature scalar X X X X
Signed master X X
=cut
# DOC_END
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
use strict;
use Carp;
use Net::XMPP::Stanza;
use Net::Jabber::Namespaces;
use base qw( Net::XMPP::Stanza );
use vars qw( $TIMEZONE );
if (eval "require Time::Timezone")
{
$TIMEZONE = 1;
Time::Timezone->import(qw(tz_local_offset tz_name));
}
else
{
$TIMEZONE = 0;
}
sub _init
{
my $self = shift;
my $result = $self->SUPER::_init(@_);
if (defined($result))
{
$result->_CustomSet_init();
return $result;
}
$self->_CustomSet_init();
return;
}
sub GetX { my $self = shift; $self->GetChild(@_); }
sub DefinedX { my $self = shift; $self->DefinedChild(@_); }
sub NewX { my $self = shift; $self->NewChild(@_); }
sub AddX { my $self = shift; $self->AddChild(@_); }
sub RemoveX { my $self = shift; $self->RemoveChild(@_); }
sub GetQuery { my $self = shift; $self->GetChild(@_); }
sub DefinedQuery { my $self = shift; $self->DefinedChild(@_); }
sub NewQuery { my $self = shift; $self->NewChild(@_); }
sub AddQuery { my $self = shift; $self->AddChild(@_); }
sub RemoveQuery { my $self = shift; $self->RemoveChild(@_); }
sub _new_jid { my $self = shift; return new Net::Jabber::JID(@_); }
sub _new_packet { my $self = shift; return new Net::Jabber::Stanza(@_); }
sub _CustomSet_init
{
my $self = shift;
$self->{CUSTOMSET}->{"time-display"} = \&_CustomSet_timedisplay;
$self->{CUSTOMSET}->{"time-tz"} = \&_CustomSet_timetz;
$self->{CUSTOMSET}->{"time-utc"} = \&_CustomSet_timeutc;
$self->{CUSTOMSET}->{"version-os"} = \&_CustomSet_versionos;
$self->{CUSTOMSET}->{"version-version"} = \&_CustomSet_versionversion;
}
sub _CustomSet_timedisplay
{
my $self = shift;
my $value = shift;
return $value if defined($value);
$self->{DATA}->{__netjabbertime__} = time
unless exists($self->{DATA}->{__netjabbertime__});
return &Net::XMPP::GetTimeStamp("local",$self->{DATA}->{__netjabbertime__});
}
sub _CustomSet_timetz
{
my $self = shift;
my $value = shift;
if (!defined($value) && ($TIMEZONE == 1))
{
return uc(&tz_name(&tz_local_offset()))
}
return $value;
}
sub _CustomSet_timeutc
{
my $self = shift;
my $value = shift;
return $value if defined($value);
$self->{DATA}->{__netjabbertime__} = time
unless exists($self->{DATA}->{__netjabbertime__});
return &Net::XMPP::GetTimeStamp("utc",$self->{DATA}->{__netjabbertime__},"stamp");
}
sub _CustomSet_versionos
{
my $self = shift;
my $value = shift;
return (&POSIX::uname())[0];
}
sub _CustomSet_versionversion
{
my $self = shift;
my $value = shift;
if (defined($value))
{
$value .= " - [ Net::Jabber v$Net::Jabber::VERSION ]";
}
else
{
$value = "Net::Jabber v$Net::Jabber::VERSION";
}
return $value;
}
sub GetResults
{
my $self = shift;
my %results;
foreach my $item ($self->GetItems())
{
my %result;
my @xData = $item->GetX("jabber:x:data");
if ($#xData == -1)
{
%result = $item->GetItem();
}
else
{
foreach my $field ($xData[0]->GetFields())
{
$result{$field->GetVar()} = $field->GetValue();
}
}
$results{$item->GetJID()} = \%result;
}
return %results;
}
1;
Net-Jabber-2.0/lib/Net/Jabber/Key.pm 0000644 0001750 0001750 00000011760 10110275744 020175 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Jabber
# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################
package Net::Jabber::Key;
=head1 NAME
Net::Jabber::Key - Jabber Key Library
=head1 SYNOPSIS
Net::Jabber::Key is a module that provides a developer easy access
to generating, caching, and comparing keys.
=head1 DESCRIPTION
Key.pm is a helper module for the Net::Jabber::Transport. When the
Transport talks to a Client it sends a key and expects to get that
key back from the Client. This module provides an API to generate,
cache, and then compare the key send from the Client.
=head2 Basic Functions
$Key = new Net::Jabber::Key();
$key = $Key->Generate();
$key = $Key->Create("bob\@jabber.org");
$test = $Key->Compare("bob\@jabber.org","some key");
=head1 METHODS
=head2 Basic Functions
new(debug=>string, - creates the Key object. debug should
debugfh=>FileHandle, be set to the path for the debug
debuglevel=>integer) log to be written. If set to "stdout"
then the debug will go there. Also, you
can specify a filehandle that already
exists and use that. debuglevel controls
the amount of debug. 0 is none, 1 is
normal, 2 is all.
Generate() - returns a key in Digest SHA1 form based on the current
time and the PID.
Create(cacheString) - generates a key and caches it with the key
of cacheString. Create returns the key.
Compare(cacheString, - compares the key stored in the cache under
keyString) cacheString with the keyString. Returns 1
if they match, and 0 otherwise.
=head1 AUTHOR
By Ryan Eatmon in May of 2000 for http://jabber.org.
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use FileHandle;
use vars qw($VERSION);
$VERSION = "2.0";
sub new
{
srand( time() ^ ($$ + ($$ << 15)));
my $proto = shift;
my $self = { };
$self->{DEBUG} = new Net::Jabber::Debug(usedefault=>1,
header=>"NJ::Key");
$self->{VERSION} = $VERSION;
$self->{CACHE} = {};
if (eval "require Digest::SHA1")
{
$self->{DIGEST} = 1;
Digest::SHA1->import(qw(sha1 sha1_hex sha1_base64));
}
else
{
print "ERROR: You cannot use Key.pm unless you have Digest::SHA1 installed.\n";
exit(0);
}
bless($self, $proto);
return $self;
}
###########################################################################
#
# Generate - returns a random string based on the PID and time and a
# random number. Then it creates an SHA1 Digest of that
# string and returns it.
#
###########################################################################
sub Generate
{
my $self = shift;
my $string = $$.time.rand(1000000);
$string = Digest::SHA1::sha1_hex($string);
$self->{DEBUG}->Log1("Generate: key($string)");
return $string;
}
##############################################################################
#
# Create - Creates a key and caches the id for comparison later.
#
##############################################################################
sub Create
{
my $self = shift;
my ($cacheString) = @_;
$self->{DEBUG}->Log1("Create: cacheString($cacheString)");
my $key = $self->Generate();
$self->{DEBUG}->Log1("Create: key($key)");
$self->{CACHE}->{$cacheString} = $key;
return $key;
}
##############################################################################
#
# Compare - Compares the key with the key in the cache.
#
##############################################################################
sub Compare
{
my $self = shift;
my ($cacheString,$key) = @_;
$self->{DEBUG}->Log1("Compare: cacheString($cacheString) key($key)");
my $cacheKey = delete($self->{CACHE}->{$cacheString});
$self->{DEBUG}->Log1("Compare: cacheKey($cacheKey)");
return ($key eq $cacheKey);
}
1;
Net-Jabber-2.0/lib/Net/Jabber/Component.pm 0000644 0001750 0001750 00000023662 10110275744 021413 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::Component;
=head1 NAME
Net::Jabber::Component - Jabber Component Library
=head1 SYNOPSIS
Net::Jabber::Component is a module that provides a developer easy
access to developing server components in the Jabber Instant Messaging
protocol.
=head1 DESCRIPTION
Component.pm seeks to provide enough high level APIs and automation of
the low level APIs that writing a Jabber Component in Perl is trivial.
For those that wish to work with the low level you can do that too,
but those functions are covered in the documentation for each module.
Net::Jabber::Component provides functions to connect to a Jabber
server, login, send and receive messages, operate as a server side
component, and disconnect. You can use all or none of the functions,
there is no requirement.
For more information on how the details for how Net::Jabber is written
please see the help for Net::Jabber itself.
For a full list of high level functions available please see
Net::Jabber::Protocol and Net::XMPP::Protocol.
=head2 Basic Functions
use Net::Jabber;
$Con = new Net::Jabber::Component();
$Con->Execute(hostname=>"jabber.org",
componentname=>"service.jabber.org",
secret=>"XXXX"
);
#
# For the list of available functions see Net::XMPP::Protocol.
#
$Con->Disconnect();
=head1 METHODS
=head2 Basic Functions
new(debuglevel=>0|1|2, - creates the Component object. debugfile
debugfile=>string, should be set to the path for the debug
debugtime=>0|1) log to be written. If set to "stdout"
then the debug will go there. debuglevel
controls the amount of debug. For more
information about the valid setting for
debuglevel, debugfile, and debugtime see
Net::Jabber::Debug.
AuthSend(secret=>string) - Perform the handshake and authenticate
with the server.
Connect(hostname=>string, - opens a connection to the server
port=>integer, based on the value of
componentname=>string, connectiontype. The only valid
connectiontype=>string) setting is:
accept - TCP/IP remote connection
In the future this might be used
again by offering new features.
If accept then it connects to the
server listed in the hostname
value, on the port listed. The
defaults for the two are localhost
and 5269.
Note: A change from previous
versions is that Component now
shares its core with Client. To
that end, the secret should no
longer be used. Call AuthSend
after connecting. Better yet,
use Execute.
Connected() - returns 1 if the Component is connected to the server,
and 0 if not.
Disconnect() - closes the connection to the server.
Execute(hostname=>string, - Generic inner loop to handle
port=>int, connecting to the server, calling
secret=>string, Process, and reconnecting if the
componentname=>string, connection is lost. There are four
connectiontype=>string, callbacks available that are called
connectattempts=>int, at various places in the loop.
connectsleep=>int) onconnect - when the component
connects to the
server.
onauth - when the component has
completed its handshake
with the server this
will be called.
onprocess - this is the most
inner loop and so
gets called the most.
Be very very careful
what you put here
since it can
*DRASTICALLY* affect
performance.
ondisconnect - when connection is
lost.
onexit - when the function gives
up trying to connect and
exits.
The arguments are passed straight
on to the Connect function, except
for connectattempts and
connectsleep. connectattempts is
the number of time that the
Component should try to connect
before giving up. -1 means try
forever. The default is -1.
connectsleep is the number of
seconds to sleep between each
connection attempt.
Process(integer) - takes the timeout period as an argument. If no
timeout is listed then the function blocks until
a packet is received. Otherwise it waits that
number of seconds and then exits so your program
can continue doing useful things. NOTE: This is
important for GUIs. You need to leave time to
process GUI commands even if you are waiting for
packets. The following are the possible return
values, and what they mean:
1 - Status ok, data received.
0 - Status ok, no data received.
undef - Status not ok, stop processing.
IMPORTANT: You need to check the output of every
Process. If you get an undef then the connection
died and you should behave accordingly.
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
use strict;
use Carp;
use Net::XMPP::Connection;
use Net::Jabber::Protocol;
use base qw( Net::XMPP::Connection Net::Jabber::Protocol );
use vars qw( $VERSION );
$VERSION = "2.0";
use Net::Jabber::XDB;
sub new
{
srand( time() ^ ($$ + ($$ << 15)));
my $proto = shift;
my $self = { };
bless($self, $proto);
$self->init(@_);
$self->{SERVER}->{port} = 5269;
$self->{SERVER}->{namespace} = "jabber:component:accept";
$self->{SERVER}->{allow_register} = 0;
return $self;
}
sub AuthSend
{
my $self = shift;
$self->_auth(@_);
}
sub _auth
{
my $self = shift;
my (%args) = @_;
$self->{STREAM}->SetCallBacks(node=>undef);
$self->Send("".Digest::SHA1::sha1_hex($self->{SESSION}->{id}.$args{secret})."");
my $handshake = $self->Process();
if (!defined($handshake) ||
($#{$handshake} == -1) ||
(ref($handshake->[0]) ne "XML::Stream::Node") ||
($handshake->[0]->get_tag() ne "handshake"))
{
$self->SetErrorCode("Bad handshake.");
return ("fail","Bad handshake.");
}
shift(@{$handshake});
foreach my $node (@{$handshake})
{
$self->CallBack($self->{SESSION}->{id},$node);
}
$self->{STREAM}->SetCallBacks(node=>sub{ $self->CallBack(@_) });
return ("ok","");
}
sub _connection_args
{
my $self = shift;
my (%args) = @_;
my %connect;
$connect{componentname} = $args{componentname};
$connect{hostname} = $args{hostname};
$connect{port} = $args{port} if exists($args{port});
$connect{connectiontype} = $args{connectiontype} if exists($args{connectiontype});
$connect{timeout} = $args{connecttimeout} if exists($args{connecttimeout});
$connect{tls} = $args{tls} if exists($args{tls});
return %connect;
}
1;
Net-Jabber-2.0/lib/Net/Jabber/Presence.pm 0000644 0001750 0001750 00000003727 10110275744 021215 0 ustar reatmon reatmon 0000000 0000000 #############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::Presence;
=head1 NAME
Net::Jabber::Presence - Jabber Presence Module
=head1 DESCRIPTION
Net::Jabber::Presence inherits all of its methods from
Net::XMPP::Presence.
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use Net::XMPP::Presence;
use base qw( Net::XMPP::Presence );
use vars qw( $VERSION );
$VERSION = "2.0";
sub GetX { my $self = shift; $self->GetChild(@_); }
sub DefinedX { my $self = shift; $self->DefinedChild(@_); }
sub NewX { my $self = shift; $self->NewChild(@_); }
sub AddX { my $self = shift; $self->AddChild(@_); }
sub RemoveX { my $self = shift; $self->RemoveChild(@_); }
sub _new_jid { my $self = shift; return new Net::Jabber::JID(@_); }
sub _new_packet { my $self = shift; return new Net::Jabber::Stanza(@_); }
sub _presence { my $self = shift; return new Net::Jabber::Presence(@_); }
1;
Net-Jabber-2.0/lib/Net/Jabber/Dialback.pm 0000644 0001750 0001750 00000006676 10110275744 021151 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Jabber
# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################
package Net::Jabber::Dialback;
=head1 NAME
Net::Jabber::Dialback - Jabber Dialback Module
=head1 SYNOPSIS
Net::Jabber::Dialback is a companion to the Net::Jabber::Server
module. It provides the user a simple interface to set and retrieve
all parts of a Jabber Server Dialback.
=head1 DESCRIPTION
To initialize the Dialback with a Jabber you must pass it
the XML::Stream hash. For example:
my $dialback = new Net::Jabber::Dialback(%hash);
You now have access to all of the retrieval functions available.
To create a new message to send to the server:
use Net::Jabber qw(Server);
$DB = new Net::Jabber::Dialback("verify");
$DB = new Net::Jabber::Dialback("result");
Please see the specific documentation for Net::Jabber::Dialback::Result
and Net::Jabber::Dialback::Verify.
For more information about the array format being passed to the
CallBack please read the Net::Jabber::Client documentation.
=head1 AUTHOR
By Ryan Eatmon in May of 2001 for http://jabber.org..
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use vars qw($VERSION $AUTOLOAD %FUNCTIONS);
$VERSION = "2.0";
use Net::Jabber::Dialback::Result;
($Net::Jabber::Dialback::Result::VERSION < $VERSION) &&
die("Net::Jabber::Dialback::Result $VERSION required--this is only version $Net::Jabber::Dialback::Result::VERSION");
use Net::Jabber::Dialback::Verify;
($Net::Jabber::Dialback::Verify::VERSION < $VERSION) &&
die("Net::Jabber::Dialback::Verify $VERSION required--this is only version $Net::Jabber::Dialback::Verify::VERSION");
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = { };
bless($self, $proto);
if ("@_" ne (""))
{
if (ref($_[0]) =~ /Net::Jabber::Dialback/)
{
return $_[0];
}
else
{
my ($temp) = @_;
return new Net::Jabber::Dialback::Result()
if ($temp eq "result");
return new Net::Jabber::Dialback::Verify()
if ($temp eq "verify");
my @temp = @{$temp};
return new Net::Jabber::Dialback::Result(@temp)
if ($temp[0] eq "db:result");
return new Net::Jabber::Dialback::Verify(@temp)
if ($temp[0] eq "db:verify");
}
}
else
{
carp "You must specify either \"result\" or \"verify\" as an argument";
}
}
1;
Net-Jabber-2.0/lib/Net/Jabber/Data.pm 0000644 0001750 0001750 00000033074 10110275744 020320 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Jabber
# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################
package Net::Jabber::Data;
=head1 NAME
Net::Jabber::Data - Jabber Data Library
=head1 SYNOPSIS
Net::Jabber::Data is a companion to the Net::Jabber::XDB module. It
provides the user a simple interface to set and retrieve all
parts of a Jabber XDB Data.
=head1 DESCRIPTION
Net::Jabber::Data differs from the other modules in that its behavior
and available functions are based off of the XML namespace that is
set in it. The current list of supported namespaces is:
jabber:iq:auth
jabber:iq:auth:0k
jabber:iq:register
jabber:iq:roster
For more information on what these namespaces are for, visit
http://www.jabber.org and browse the Jabber Programmers Guide.
Each of these namespaces provide Net::Jabber::Data with the functions
to access the data. By using the AUTOLOAD function the functions for
each namespace is used when that namespace is active.
To access a Data object you must create an XDB object and use the
access functions there to get to the Data. To initialize the XDB with
a Jabber you must pass it the XML::Stream hash from the
Net::Jabber::Client module.
my $xdb = new Net::Jabber::XDB(%hash);
There has been a change from the old way of handling the callbacks.
You no longer have to do the above yourself, a Net::Jabber::XDB
object is passed to the callback function for the message. Also,
the first argument to the callback functions is the session ID from
XML::Streams. There are some cases where you might want this
information, like if you created a Client that connects to two servers
at once, or for writing a mini server.
use Net::Jabber qw(Client);
sub xdbCB {
my ($sid,$XDB) = @_;
my $data = $XDB->GetData();
.
.
.
}
You now have access to all of the retrieval functions available for
that namespace.
To create a new xdb to send to the server:
use Net::Jabber;
my $xdb = new Net::Jabber::XDB();
$data = $xdb->NewData("jabber:iq:auth");
Now you can call the creation functions for the Data as defined in the
proper namespaces. See below for the general functions, and
in each data module for those functions.
For more information about the array format being passed to the
CallBack please read the Net::Jabber::Client documentation.
=head1 METHODS
=head2 Retrieval functions
GetXMLNS() - returns a string with the namespace of the data that
the contains.
$xmlns = $XDB->GetXMLNS();
GetData() - since the behavior of this module depends on the
namespace, a Data object may contain Data objects.
This helps to leverage code reuse by making children
behave in the same manner. More than likely this
function will never be called.
@data = GetData()
=head2 Creation functions
SetXMLNS(string) - sets the xmlns of the to the string.
$data->SetXMLNS("jabber:xdb:roster");
In an effort to make maintaining this document easier, I am not going
to go into full detail on each of these functions. Rather I will
present the functions in a list with a type in the first column to
show what they return, or take as arugments. Here is the list of
types I will use:
string - just a string
array - array of strings
flag - this means that the specified child exists in the
XML and acts like a flag. get will return
0 or 1.
JID - either a string or Net::Jabber::JID object.
objects - creates new objects, or returns an array of
objects.
special - this is a special case kind of function. Usually
just by calling Set() with no arguments it will
default the value to a special value, like OS or time.
Sometimes it will modify the value you set, like
in jabber:xdb:version SetVersion() the function
adds on the Net::Jabber version to the string
just for advertisement purposes. =)
master - this desribes a function that behaves like the
SetMessage() function in Net::Jabber::Message.
It takes a hash and sets all of the values defined,
and the Set returns a hash with the values that
are defined in the object.
=head1 jabber:iq:
Type Get Set Defined
======= ================ ================ ==================
=head1 jabber:iq:
Type Get Set Defined
======= ================ ================ ==================
=head1 jabber:iq:
Type Get Set Defined
======= ================ ================ ==================
=head1 jabber:iq:
Type Get Set Defined
======= ================ ================ ==================
=head1 jabber:iq:
Type Get Set Defined
======= ================ ================ ==================
=head1 CUSTOM NAMESPACES
Part of the flexability of this module is that you can define your own
namespace. For more information on this topic, please read the
Net::Jabber::Namespaces man page.
=head1 AUTHOR
By Ryan Eatmon in May of 2001 for http://jabber.org..
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use vars qw($VERSION $AUTOLOAD %FUNCTIONS %NAMESPACES);
$VERSION = "2.0";
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = { };
$self->{VERSION} = $VERSION;
bless($self, $proto);
$self->{DEBUGHEADER} = "Data";
$self->{DATA} = {};
$self->{CHILDREN} = {};
$self->{TAG} = "data";
if ("@_" ne (""))
{
if (ref($_[0]) eq "Net::Jabber::Data")
{
return $_[0];
}
else
{
$self->{TREE} = shift;
$self->{TAG} = $self->{TREE}->get_tag();
$self->ParseXMLNS();
$self->ParseTree();
}
}
return $self;
}
##############################################################################
#
# AUTOLOAD - This function calls the main AutoLoad function in Jabber.pm
#
##############################################################################
sub AUTOLOAD
{
my $self = shift;
&Net::Jabber::AutoLoad($self,$AUTOLOAD,@_);
}
$FUNCTIONS{XMLNS}->{Get} = "xmlns";
$FUNCTIONS{XMLNS}->{Set} = ["scalar","xmlns"];
$FUNCTIONS{XMLNS}->{Defined} = "xmlns";
$FUNCTIONS{XMLNS}->{Hash} = "att";
$FUNCTIONS{Data}->{Get} = "__netjabber__:children:data";
$FUNCTIONS{Data}->{Defined} = "__netjabber__:children:data";
#-----------------------------------------------------------------------------
# jabber:iq:auth
#-----------------------------------------------------------------------------
$NAMESPACES{"jabber:iq:auth"}->{Password}->{Get} = "password";
$NAMESPACES{"jabber:iq:auth"}->{Password}->{Set} = ["scalar","password"];
$NAMESPACES{"jabber:iq:auth"}->{Password}->{Defined} = "password";
$NAMESPACES{"jabber:iq:auth"}->{Password}->{Hash} = "data";
$NAMESPACES{"jabber:iq:auth"}->{Auth}->{Get} = "__netjabber__:master";
$NAMESPACES{"jabber:iq:auth"}->{Auth}->{Set} = ["master"];
$NAMESPACES{"jabber:iq:auth"}->{"__netjabber__"}->{Tag} = "password";
#-----------------------------------------------------------------------------
# jabber:iq:auth:0k
#-----------------------------------------------------------------------------
$NAMESPACES{"jabber:iq:auth:0k"}->{Hash}->{Get} = "hash";
$NAMESPACES{"jabber:iq:auth:0k"}->{Hash}->{Set} = ["scalar","hash"];
$NAMESPACES{"jabber:iq:auth:0k"}->{Hash}->{Defined} = "hash";
$NAMESPACES{"jabber:iq:auth:0k"}->{Hash}->{Hash} = "child-data";
$NAMESPACES{"jabber:iq:auth:0k"}->{Sequence}->{Get} = "sequence";
$NAMESPACES{"jabber:iq:auth:0k"}->{Sequence}->{Set} = ["scalar","sequence"];
$NAMESPACES{"jabber:iq:auth:0k"}->{Sequence}->{Defined} = "sequence";
$NAMESPACES{"jabber:iq:auth:0k"}->{Sequence}->{Hash} = "child-data";
$NAMESPACES{"jabber:iq:auth:0k"}->{Token}->{Get} = "token";
$NAMESPACES{"jabber:iq:auth:0k"}->{Token}->{Set} = ["scalar","token"];
$NAMESPACES{"jabber:iq:auth:0k"}->{Token}->{Defined} = "token";
$NAMESPACES{"jabber:iq:auth:0k"}->{Token}->{Hash} = "child-data";
$NAMESPACES{"jabber:iq:auth:0k"}->{ZeroK}->{Get} = "__netjabber__:master";
$NAMESPACES{"jabber:iq:auth:0k"}->{ZeroK}->{Set} = ["master"];
$NAMESPACES{"jabber:iq:auth:0k"}->{"__netjabber__"}->{Tag} = "zerok";
#-----------------------------------------------------------------------------
# jabber:iq:last
#-----------------------------------------------------------------------------
$NAMESPACES{"jabber:iq:last"}->{Message}->{Get} = "message";
$NAMESPACES{"jabber:iq:last"}->{Message}->{Set} = ["scalar","message"];
$NAMESPACES{"jabber:iq:last"}->{Message}->{Defined} = "message";
$NAMESPACES{"jabber:iq:last"}->{Message}->{Hash} = "data";
$NAMESPACES{"jabber:iq:last"}->{Seconds}->{Get} = "last";
$NAMESPACES{"jabber:iq:last"}->{Seconds}->{Set} = ["scalar","last"];
$NAMESPACES{"jabber:iq:last"}->{Seconds}->{Defined} = "last";
$NAMESPACES{"jabber:iq:last"}->{Seconds}->{Hash} = "att";
$NAMESPACES{"jabber:iq:last"}->{Last}->{Get} = "__netjabber__:master";
$NAMESPACES{"jabber:iq:last"}->{Last}->{Set} = ["master"];
$NAMESPACES{"jabber:iq:last"}->{"__netjabber__"}->{Tag} = "query";
#-----------------------------------------------------------------------------
# jabber:iq:roster
#-----------------------------------------------------------------------------
$NAMESPACES{"jabber:iq:roster"}->{Item}->{Get} = "";
$NAMESPACES{"jabber:iq:roster"}->{Item}->{Set} = ["add","Data","__netjabber__:iq:roster:item"];
$NAMESPACES{"jabber:iq:roster"}->{Item}->{Defined} = "__netjabber__:children:data";
$NAMESPACES{"jabber:iq:roster"}->{Item}->{Hash} = "child-add";
$NAMESPACES{"jabber:iq:roster"}->{Item}->{Add} = ["Data","__netjabber__:iq:roster:item","Item","item"];
$NAMESPACES{"jabber:iq:roster"}->{Items}->{Get} = ["__netjabber__:children:data","__netjabber__:iq:roster:item"];
$NAMESPACES{"jabber:iq:roster"}->{"__netjabber__"}->{Tag} = "query";
#-----------------------------------------------------------------------------
# __netjabber__:iq:roster:item
#-----------------------------------------------------------------------------
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Ask}->{Get} = "ask";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Ask}->{Set} = ["scalar","ask"];
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Ask}->{Defined} = "ask";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Ask}->{Hash} = "att";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Group}->{Get} = "group";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Group}->{Set} = ["array","group"];
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Group}->{Defined} = "group";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Group}->{Hash} = "child-data";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{JID}->{Get} = "jid";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{JID}->{Set} = ["jid","jid"];
$NAMESPACES{"__netjabber__:iq:roster:item"}->{JID}->{Defined} = "jid";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{JID}->{Hash} = "att";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Name}->{Get} = "name";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Name}->{Set} = ["scalar","name"];
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Name}->{Defined} = "name";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Name}->{Hash} = "att";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Subscription}->{Get} = "subscription";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Subscription}->{Set} = ["scalar","subscription"];
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Subscription}->{Defined} = "subscription";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Subscription}->{Hash} = "att";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Item}->{Get} = "__netjabber__:master";
$NAMESPACES{"__netjabber__:iq:roster:item"}->{Item}->{Set} = ["master"];
#-----------------------------------------------------------------------------
# jabber:x:offline
#-----------------------------------------------------------------------------
$NAMESPACES{"jabber:x:offline"}->{Data}->{Get} = "data";
$NAMESPACES{"jabber:x:offline"}->{Data}->{Set} = ["scalar","data"];
$NAMESPACES{"jabber:x:offline"}->{Data}->{Defined} = "data";
$NAMESPACES{"jabber:x:offline"}->{Data}->{Hash} = "data";
$NAMESPACES{"jabber:x:offline"}->{Offline}->{Get} = "__netjabber__:master";
$NAMESPACES{"jabber:x:offline"}->{Offline}->{Set} = ["master"];
$NAMESPACES{"jabber:x:offline"}->{"__netjabber__"}->{Tag} = "foo";
1;
Net-Jabber-2.0/lib/Net/Jabber/Log.pm 0000644 0001750 0001750 00000021706 10110275744 020167 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Jabber
# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################
package Net::Jabber::Log;
=head1 NAME
Net::Jabber::Log - Jabber Log Module
=head1 SYNOPSIS
Net::Jabber::Log is a companion to the Net::Jabber module.
It provides the user a simple interface to set and retrieve all
parts of a Jabber Log.
=head1 DESCRIPTION
To initialize the Log with a Jabber you must pass it the
XML::Parser Tree array. For example:
my $log = new Net::Jabber::Log(@tree);
There has been a change from the old way of handling the callbacks.
You no longer have to do the above, a Net::Jabber::Log object is passed
to the callback function for the log:
use Net::Jabber;
sub log {
my ($Log) = @_;
.
.
.
}
You now have access to all of the retrieval functions available.
To create a new log to send to the server:
use Net::Jabber;
$Log = new Net::Jabber::Log();
Now you can call the creation functions below to populate the tag before
sending it.
For more information about the array format being passed to the CallBack
please read the Net::Jabber::Client documentation.
=head2 Retrieval functions
$from = $Log->GetFrom();
$fromJID = $Log->GetFrom("jid");
$type = $Log->GetType();
$data = $Log->GetData();
$str = $Log->GetXML();
@log = $Log->GetTree();
=head2 Creation functions
$Log->SetLog(type=>"error",
from=>"users.jabber.org",
data=>"The moon is full... I can't run anymore.");
$Log->SetFrom("foo.jabber.org");
$Log->SetType("warn");
$Log->SetData("I can't find a config file. Using defaults.");
=head2 Test functions
$test = $Log->DefinedFrom();
$test = $Log->DefinedType();
=head1 METHODS
=head2 Retrieval functions
GetFrom() - returns either a string with the Jabber Identifier,
GetFrom("jid") or a Net::Jabber::JID object for the person who
sent the . To get the JID object set
the string to "jid", otherwise leave blank for the
text string.
GetType() - returns a string with the type this is.
GetData() - returns a string with the cdata of the .
GetXML() - returns the XML string that represents the .
This is used by the Send() function in Client.pm to send
this object as a Jabber Log.
GetTree() - returns an array that contains the tag
in XML::Parser Tree format.
=head2 Creation functions
SetLog(from=>string|JID, - set multiple fields in the
type=>string, at one time. This is a cumulative
data=>string) and over writing action. If you set
the "from" attribute twice, the second
setting is what is used. If you set
the type, and then set the data
then both will be in the
tag. For valid settings read the
specific Set functions below.
SetFrom(string) - sets the from attribute. You can either pass a string
SetFrom(JID) or a JID object. They must be valid Jabber
Identifiers or the server will return an error log.
(ie. jabber:bob@jabber.org/Silent Bob, etc...)
SetType(string) - sets the type attribute. Valid settings are:
notice general logging
warn warning
alert critical error (can still run but not
correctly)
error fatal error (cannot run anymore)
SetData(string) - sets the cdata of the .
=head2 Test functions
DefinedFrom() - returns 1 if the from attribute is defined in the
, 0 otherwise.
DefinedType() - returns 1 if the type attribute is defined in the
, 0 otherwise.
=head1 AUTHOR
By Ryan Eatmon in May of 2000 for http://jabber.org..
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use vars qw($VERSION $AUTOLOAD %FUNCTIONS);
$VERSION = "2.0";
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = { };
$self->{VERSION} = $VERSION;
$self->{TIMESTAMP} = &Net::Jabber::GetTimeStamp("local");
bless($self, $proto);
$self->{DEBUG} = new Net::Jabber::Debug(usedefault=>1,
header=>"NJ::Log");
if ("@_" ne (""))
{
if (ref($_[0]) eq "Net::Jabber::Log")
{
return $_[0];
}
else
{
my @temp = @_;
$self->{LOG} = \@temp;
}
}
else
{
$self->{LOG} = [ "log" , [{}]];
}
return $self;
}
##############################################################################
#
# AUTOLOAD - This function calls the delegate with the appropriate function
# name and argument list.
#
##############################################################################
sub AUTOLOAD
{
my $self = shift;
return if ($AUTOLOAD =~ /::DESTROY$/);
$AUTOLOAD =~ s/^.*:://;
my ($type,$value) = ($AUTOLOAD =~ /^(Get|Set|Defined)(.*)$/);
$type = "" unless defined($type);
my $treeName = "LOG";
return "log" if ($AUTOLOAD eq "GetTag");
return &XML::Stream::BuildXML(@{$self->{$treeName}}) if ($AUTOLOAD eq "GetXML");
return @{$self->{$treeName}} if ($AUTOLOAD eq "GetTree");
return &Net::Jabber::Get($self,$self,$value,$treeName,$FUNCTIONS{get}->{$value},@_) if ($type eq "Get");
return &Net::Jabber::Set($self,$self,$value,$treeName,$FUNCTIONS{set}->{$value},@_) if ($type eq "Set");
return &Net::Jabber::Defined($self,$self,$value,$treeName,$FUNCTIONS{defined}->{$value},@_) if ($type eq "Defined");
return &Net::Jabber::debug($self,$treeName) if ($AUTOLOAD eq "debug");
&Net::Jabber::MissingFunction($self,$AUTOLOAD);
}
$FUNCTIONS{get}->{From} = ["value","","from"];
$FUNCTIONS{get}->{Type} = ["value","","type"];
$FUNCTIONS{get}->{Data} = ["value","",""];
$FUNCTIONS{set}->{Type} = ["single","","","type","*"];
$FUNCTIONS{set}->{Data} = ["single","","*","",""];
$FUNCTIONS{defined}->{From} = ["existence","","from"];
$FUNCTIONS{defined}->{Type} = ["existence","","type"];
##############################################################################
#
# GetXML - returns the XML string that represents the data in the XML::Parser
# Tree.
#
##############################################################################
sub GetXML
{
my $self = shift;
$self->MergeX();
return &XML::Stream::BuildXML(@{$self->{LOG}});
}
##############################################################################
#
# GetTree - returns the XML::Parser Tree that is stored in the guts of
# the object.
#
##############################################################################
sub GetTree
{
my $self = shift;
$self->MergeX();
return %{$self->{LOG}};
}
##############################################################################
#
# SetLog - takes a hash of all of the things you can set on a
# and sets each one.
#
##############################################################################
sub SetLog
{
my $self = shift;
my %log;
while($#_ >= 0) { $log{ lc pop(@_) } = pop(@_); }
$self->SetFrom($log{from}) if exists($log{from});
$self->SetType($log{type}) if exists($log{type});
$self->SetData($log{data}) if exists($log{data});
}
##############################################################################
#
# SetFrom - sets the from attribute in the
#
##############################################################################
sub SetFrom
{
my $self = shift;
my ($from) = @_;
if (ref($from) eq "Net::Jabber::JID")
{
$from = $from->GetJID("full");
}
return unless ($from ne "");
&XML::Stream::SetXMLData("single",$self->{LOG},"","",{from=>$from});
}
1;
Net-Jabber-2.0/lib/Net/Jabber/IQ.pm 0000644 0001750 0001750 00000004431 10110275744 017753 0 ustar reatmon reatmon 0000000 0000000 ##############################################################################
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################
package Net::Jabber::IQ;
=head1 NAME
Net::Jabber::IQ - Jabber Info/Query Library
=head1 DESCRIPTION
Net::Jabber::IQ inherits all of its methods from Net::XMPP::IQ.
=head1 AUTHOR
Ryan Eatmon
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require 5.003;
use strict;
use Carp;
use Net::XMPP::IQ;
use base qw( Net::XMPP::IQ );
use vars qw( $VERSION );
$VERSION = "2.0";
sub GetQuery { my $self = shift; $self->GetChild(@_); }
sub DefinedQuery { my $self = shift; $self->DefinedChild(@_); }
sub NewQuery { my $self = shift; $self->RemoveFirstChild(); $self->NewFirstChild(@_); }
sub AddQuery { my $self = shift; $self->AddChild(@_); }
sub RemoveQuery { my $self = shift; $self->RemoveFirstChild(@_); }
sub GetX { my $self = shift; $self->GetChild(@_); }
sub DefinedX { my $self = shift; $self->DefinedChild(@_); }
sub NewX { my $self = shift; $self->NewChild(@_); }
sub AddX { my $self = shift; $self->AddChild(@_); }
sub RemoveX { my $self = shift; $self->RemoveChild(@_); }
sub _new_jid { my $self = shift; return new Net::Jabber::JID(@_); }
sub _new_packet { my $self = shift; return new Net::Jabber::Stanza(@_); }
sub _iq { my $self = shift; return new Net::Jabber::IQ(@_); }
1;
Net-Jabber-2.0/t/ 0002755 0001750 0001750 00000000000 10112242737 014664 5 ustar reatmon reatmon 0000000 0000000 Net-Jabber-2.0/t/query_oob.t 0000644 0001750 0001750 00000001700 10110275744 017053 0 ustar reatmon reatmon 0000000 0000000 use lib "t/lib";
use Test::More tests=>25;
BEGIN{ use_ok( "Net::Jabber" ); }
require "t/mytestlib.pl";
my $query = new Net::Jabber::Stanza("query");
ok( defined($query), "new()" );
isa_ok( $query, "Net::Jabber::Stanza" );
isa_ok( $query, "Net::XMPP::Stanza" );
testScalar($query,"XMLNS","jabber:iq:oob");
testScalar($query,"Desc","desc");
testScalar($query,"URL","url");
is( $query->GetXML(), "descurl", "GetXML()" );
my $query2 = new Net::Jabber::Stanza("query");
ok( defined($query2), "new()" );
isa_ok( $query2, "Net::Jabber::Stanza" );
isa_ok( $query2, "Net::XMPP::Stanza" );
testScalar($query2,"XMLNS","jabber:iq:oob");
$query2->SetOob(desc=>"desc",
url=>"url"
);
testPostScalar($query2,"Desc","desc");
testPostScalar($query2,"URL","url");
is( $query2->GetXML(), "descurl", "GetXML()" );
Net-Jabber-2.0/t/query_si_filetrans.t 0000644 0001750 0001750 00000010417 10110275744 020763 0 ustar reatmon reatmon 0000000 0000000 use lib "t/lib";
use Test::More tests=>100;
BEGIN{ use_ok( "Net::Jabber" ); }
require "t/mytestlib.pl";
my $query = new Net::Jabber::Stanza("si");
ok( defined($query), "new()" );
isa_ok( $query, "Net::Jabber::Stanza" );
isa_ok( $query, "Net::XMPP::Stanza" );
testScalar($query,"XMLNS","http://jabber.org/protocol/si");
testScalar($query,"Profile","http://jabber.org/protocol/si/profile/file-transfer");
my $prof = $query->NewChild("http://jabber.org/protocol/si/profile/file-transfer");
testScalar($prof,"Date","date");
testScalar($prof,"Desc","desc");
testScalar($prof,"Hash","hash");
testScalar($prof,"Name","name");
testScalar($prof,"RangeLength","length");
testScalar($prof,"RangeOffset","offest");
testScalar($prof,"Size","size");
is( $query->GetXML(), "desc", "GetXML()" );
my $query2 = new Net::Jabber::Stanza("si");
ok( defined($query2), "new()" );
isa_ok( $query2, "Net::Jabber::Stanza" );
isa_ok( $query2, "Net::XMPP::Stanza" );
testScalar($query2,"XMLNS","http://jabber.org/protocol/si");
testScalar($query2,"Profile","http://jabber.org/protocol/si/profile/file-transfer");
my $prof2 = $query2->NewChild("http://jabber.org/protocol/si/profile/file-transfer");
testScalar($prof2,"Date","date");
testScalar($prof2,"Hash","hash");
testScalar($prof2,"Name","name");
testFlag($prof2,"Range");
testScalar($prof2,"Size","size");
is( $query2->GetXML(), "", "GetXML()" );
my $query3 = new Net::Jabber::Stanza("si");
ok( defined($query3), "new()" );
isa_ok( $query3, "Net::Jabber::Stanza" );
isa_ok( $query3, "Net::XMPP::Stanza" );
testScalar($query3,"XMLNS","http://jabber.org/protocol/si");
$query3->SetStream(profile=>"http://jabber.org/protocol/si/profile/file-transfer");
testPostScalar($query3,"Profile","http://jabber.org/protocol/si/profile/file-transfer");
my $prof3 = $query3->NewChild("http://jabber.org/protocol/si/profile/file-transfer");
$prof3->SetFile(date=>"date",
desc=>"desc",
hash=>"hash",
name=>"name",
rangelength=>"length",
rangeoffset=>"offset",
size=>"size"
);
testPostScalar($prof3,"Date","date");
testPostScalar($prof3,"Desc","desc");
testPostScalar($prof3,"Hash","hash");
testPostScalar($prof3,"Name","name");
testPostScalar($prof3,"RangeLength","length");
testPostScalar($prof3,"RangeOffset","offset");
testPostScalar($prof3,"Size","size");
is( $query3->GetXML(), "desc", "GetXML()" );
my $query4 = new Net::Jabber::Stanza("si");
ok( defined($query4), "new()" );
isa_ok( $query4, "Net::Jabber::Stanza" );
isa_ok( $query4, "Net::XMPP::Stanza" );
testScalar($query4,"XMLNS","http://jabber.org/protocol/si");
$query4->SetStream(profile=>"http://jabber.org/protocol/si/profile/file-transfer");
testPostScalar($query4,"Profile","http://jabber.org/protocol/si/profile/file-transfer");
my $prof4 = $query4->NewChild("http://jabber.org/protocol/si/profile/file-transfer");
$prof4->SetFile(date=>"date",
hash=>"hash",
name=>"name",
range=>1,
size=>"size"
);
testPostScalar($prof4,"Date","date");
testPostScalar($prof4,"Hash","hash");
testPostScalar($prof4,"Name","name");
testPostFlag($prof4,"Range");
testPostScalar($prof4,"Size","size");
is( $query4->GetXML(), "", "GetXML()" );
Net-Jabber-2.0/t/query_gateway.t 0000644 0001750 0001750 00000002352 10110275744 017741 0 ustar reatmon reatmon 0000000 0000000 use lib "t/lib";
use Test::More tests=>42;
BEGIN{ use_ok( "Net::Jabber" ); }
require "t/mytestlib.pl";
my $query = new Net::Jabber::Stanza("query");
ok( defined($query), "new()" );
isa_ok( $query, "Net::Jabber::Stanza" );
isa_ok( $query, "Net::XMPP::Stanza" );
testScalar($query,"XMLNS","jabber:iq:gateway");
testJID($query,"JID","user1","server1","resource1");
testScalar($query,"Desc","desc");
testScalar($query,"Prompt","prompt");
is( $query->GetXML(), "user1\@server1/resource1descprompt", "GetXML()" );
my $query2 = new Net::Jabber::Stanza("query");
ok( defined($query2), "new()" );
isa_ok( $query2, "Net::Jabber::Stanza" );
isa_ok( $query2, "Net::XMPP::Stanza" );
testScalar($query2,"XMLNS","jabber:iq:gateway");
$query2->SetGateway(jid=>"user2\@server2/resource2",
desc=>"desc",
prompt=>"prompt"
);
testPostJID($query2,"JID","user2","server2","resource2");
testPostScalar($query2,"Desc","desc");
testPostScalar($query2,"Prompt","prompt");
is( $query2->GetXML(), "descuser2\@server2/resource2prompt", "GetXML()" );
Net-Jabber-2.0/t/query_search.t 0000644 0001750 0001750 00000012052 10110275744 017543 0 ustar reatmon reatmon 0000000 0000000 use lib "t/lib";
use Test::More tests=>140;
BEGIN{ use_ok( "Net::Jabber" ); }
require "t/mytestlib.pl";
my $query = new Net::Jabber::Stanza("query");
ok( defined($query), "new()" );
isa_ok( $query, "Net::Jabber::Stanza" );
isa_ok( $query, "Net::XMPP::Stanza" );
testScalar($query,"XMLNS","jabber:iq:search");
testScalar($query,"Email","email");
testScalar($query,"Family","family");
testScalar($query,"First","first");
testScalar($query,"Given","given");
testScalar($query,"Instructions","instructions");
testScalar($query,"Key","key");
testScalar($query,"Last","last");
testScalar($query,"Name","name");
testScalar($query,"Nick","nick");
testFlag($query,"Truncated");
is( $query->GetXML(), "emailfamilyfirstgiveninstructionskeylastnamenick", "GetXML()" );
my $query2 = new Net::Jabber::Stanza("query");
ok( defined($query2), "new()" );
isa_ok( $query2, "Net::Jabber::Stanza" );
isa_ok( $query2, "Net::XMPP::Stanza" );
testScalar($query2,"XMLNS","jabber:iq:search");
$query2->SetSearch(email=>"email",
family=>"family",
first=>"first",
given=>"given",
instructions=>"instructions",
key=>"key",
last=>"last",
name=>"name",
nick=>"nick",
truncated=>1,
);
testPostScalar($query2,"Email","email");
testPostScalar($query2,"Family","family");
testPostScalar($query2,"First","first");
testPostScalar($query2,"Given","given");
testPostScalar($query2,"Instructions","instructions");
testPostScalar($query2,"Key","key");
testPostScalar($query2,"Last","last");
testPostScalar($query2,"Name","name");
testPostScalar($query2,"Nick","nick");
testPostFlag($query2,"Truncated");
is( $query2->GetXML(), "emailfamilyfirstgiveninstructionskeylastnamenick", "GetXML()" );
my $query3 = new Net::Jabber::Stanza("query");
ok( defined($query3), "new()" );
isa_ok( $query3, "Net::Jabber::Stanza" );
isa_ok( $query3, "Net::XMPP::Stanza" );
testScalar($query3,"XMLNS","jabber:iq:search");
my $item1 = $query3->AddItem();
ok( defined($item1), "new()" );
isa_ok( $item1, "Net::Jabber::Stanza" );
isa_ok( $item1, "Net::XMPP::Stanza" );
testScalar($item1,"Email","email");
testScalar($item1,"Family","family");
testScalar($item1,"First","first");
testScalar($item1,"Given","given");
testJID($item1,"JID","user1","server1","resource1");
testScalar($item1,"Key","key");
testScalar($item1,"Last","last");
testScalar($item1,"Name","name");
testScalar($item1,"Nick","nick");
is( $query3->GetXML(), "emailfamilyfirstgivenkeylastnamenick", "GetXML()" );
my $item2 = $query3->AddItem(email=>"email",
family=>"family",
first=>"first",
given=>"given",
jid=>"user2\@server2/resource2",
key=>"key",
last=>"last",
name=>"name",
nick=>"nick",
);
ok( defined($item2), "new()" );
isa_ok( $item2, "Net::Jabber::Stanza" );
isa_ok( $item2, "Net::XMPP::Stanza" );
testPostScalar($item2,"Email","email");
testPostScalar($item2,"Family","family");
testPostScalar($item2,"First","first");
testPostScalar($item2,"Given","given");
testPostJID($item2,"JID","user2","server2","resource2");
testPostScalar($item2,"Key","key");
testPostScalar($item2,"Last","last");
testPostScalar($item2,"Name","name");
testPostScalar($item2,"Nick","nick");
is( $query3->GetXML(), "emailfamilyfirstgivenkeylastnamenickemailfamilyfirstgivenkeylastnamenick", "GetXML()" );
my @items = $query3->GetItems();
is( $#items, 1, "are there two items?" );
is( $items[0]->GetXML(), "emailfamilyfirstgivenkeylastnamenick", "GetXML()" );
is( $items[1]->GetXML(), "emailfamilyfirstgivenkeylastnamenick", "GetXML()" );
Net-Jabber-2.0/t/query_conference.t 0000644 0001750 0001750 00000002571 10110275744 020412 0 ustar reatmon reatmon 0000000 0000000 use lib "t/lib";
use Test::More tests=>41;
BEGIN{ use_ok( "Net::Jabber" ); }
require "t/mytestlib.pl";
my $query = new Net::Jabber::Stanza("query");
ok( defined($query), "new()" );
isa_ok( $query, "Net::Jabber::Stanza" );
isa_ok( $query, "Net::XMPP::Stanza" );
testScalar($query,"XMLNS","jabber:iq:conference");
testScalar($query,"ID","id");
testScalar($query,"Name","name");
testScalar($query,"Nick","nick");
testFlag($query,"Privacy");
testScalar($query,"Secret","secret");
is( $query->GetXML(), "idnamenicksecret", "GetXML()" );
my $query2 = new Net::Jabber::Stanza("query");
ok( defined($query2), "new()" );
isa_ok( $query2, "Net::Jabber::Stanza" );
isa_ok( $query2, "Net::XMPP::Stanza" );
testScalar($query2,"XMLNS","jabber:iq:conference");
$query2->SetConference(id=>"id",
name=>"name",
nick=>"nick",
privacy=>1,
secret=>"secret");
testPostScalar($query2,"ID","id");
testPostScalar($query2,"Name","name");
testPostScalar($query2,"Nick","nick");
testPostFlag($query2,"Privacy");
testPostScalar($query2,"Secret","secret");
is( $query2->GetXML(), "idnamenicksecret", "GetXML()" );
Net-Jabber-2.0/t/query_agents.t 0000644 0001750 0001750 00000003041 10110275744 017555 0 ustar reatmon reatmon 0000000 0000000 use lib "t/lib";
use Test::More tests=>20;
BEGIN{ use_ok( "Net::Jabber" ); }
require "t/mytestlib.pl";
my $query = new Net::Jabber::Stanza("query");
ok( defined($query), "new()" );
isa_ok( $query, "Net::Jabber::Stanza" );
isa_ok( $query, "Net::XMPP::Stanza" );
testScalar($query,"XMLNS","jabber:iq:agents");
my $agent = $query->AddAgent();
ok( defined($agent), "AddAgent()");
isa_ok($agent, "Net::Jabber::Stanza");
isa_ok($agent, "Net::XMPP::Stanza");
is( $agent->GetXMLNS(), "jabber:iq:agent", "xmlns = 'jabber:iq:agent'");
$agent->SetAgent(jid=>"user1\@server1/resource1",
name=>"name1");
is( $query->GetXML(), "name1", "GetXML()" );
my $agent2 = $query->AddAgent(jid=>"user2\@server2/resource2",
name=>"name2");
ok( defined($agent2), "AddAgent()");
isa_ok($agent2, "Net::Jabber::Stanza");
isa_ok($agent2, "Net::XMPP::Stanza");
is( $agent2->GetXMLNS(), "jabber:iq:agent", "xmlns = 'jabber:iq:agent'");
is( $query->GetXML(), "name1name2", "GetXML()" );
my @agents = $query->GetAgents();
is( $#agents, 1, "two agents?");
is( $agents[0]->GetXML(), "name1", "agent GetXML()" );
is( $agents[1]->GetXML(), "name2", "agent GetXML()" );
Net-Jabber-2.0/t/query_rpc.t 0000644 0001750 0001750 00000020540 10110275744 017063 0 ustar reatmon reatmon 0000000 0000000 use lib "t/lib";
use Test::More tests=>217;
BEGIN{ use_ok( "Net::Jabber" ); }
require "t/mytestlib.pl";
my $query = new Net::Jabber::Stanza("query");
ok( defined($query), "new()" );
isa_ok( $query, "Net::Jabber::Stanza" );
isa_ok( $query, "Net::XMPP::Stanza" );
testScalar($query,"XMLNS","jabber:iq:rpc");
my $methodCall = $query->AddMethodCall();
ok( defined($methodCall), "new()" );
isa_ok( $methodCall, "Net::Jabber::Stanza" );
isa_ok( $methodCall, "Net::XMPP::Stanza" );
ok( $query->DefinedMethodCall(), "DefinedMethodCall()" );
testScalar($methodCall, "MethodName", "method_name");
my $params = $methodCall->AddParams();
ok( defined($params), "new()" );
isa_ok( $params, "Net::Jabber::Stanza" );
isa_ok( $params, "Net::XMPP::Stanza" );
my $param1 = $params->AddParam();
ok( defined($param1), "new()" );
isa_ok( $param1, "Net::Jabber::Stanza" );
isa_ok( $param1, "Net::XMPP::Stanza" );
my $value1_1 = $param1->AddValue();
ok( defined($value1_1), "new()" );
isa_ok( $value1_1, "Net::Jabber::Stanza" );
isa_ok( $value1_1, "Net::XMPP::Stanza" );
testScalar($value1_1, "Base64", "value");
testScalar($value1_1, "Boolean", "value");
testScalar($value1_1, "DateTime", "value");
testScalar($value1_1, "Double", "value");
testScalar($value1_1, "I4", "value");
testScalar($value1_1, "Int", "value");
testScalar($value1_1, "String", "value");
testScalar($value1_1, "Value", "value");
my $struct1 = $value1_1->AddStruct();
my $member1 = $struct1->AddMember();
ok( defined($member1), "new()" );
isa_ok( $member1, "Net::Jabber::Stanza" );
isa_ok( $member1, "Net::XMPP::Stanza" );
testScalar($member1, "Name", "name");
my $member1_value1 = $member1->AddValue();
ok( defined($member1_value1), "new()" );
isa_ok( $member1_value1, "Net::Jabber::Stanza" );
isa_ok( $member1_value1, "Net::XMPP::Stanza" );
testScalar($member1_value1, "Base64", "base64");
testScalar($member1_value1, "Boolean", "boolean");
testScalar($member1_value1, "DateTime", "datetime");
testScalar($member1_value1, "Double", "double");
testScalar($member1_value1, "I4", "i4");
testScalar($member1_value1, "Int", "int");
testScalar($member1_value1, "String", "string");
testScalar($member1_value1, "Value", "value");
my $array1 = $value1_1->AddArray();
my $data1 = $array1->AddData();
ok( defined($data1), "new()" );
isa_ok( $data1, "Net::Jabber::Stanza" );
isa_ok( $data1, "Net::XMPP::Stanza" );
my $data1_value1 = $data1->AddValue();
ok( defined($data1_value1), "new()" );
isa_ok( $data1_value1, "Net::Jabber::Stanza" );
isa_ok( $data1_value1, "Net::XMPP::Stanza" );
testScalar($data1_value1, "Base64", "base64");
testScalar($data1_value1, "Boolean", "boolean");
testScalar($data1_value1, "DateTime", "datetime");
testScalar($data1_value1, "Double", "double");
testScalar($data1_value1, "I4", "i4");
testScalar($data1_value1, "Int", "int");
testScalar($data1_value1, "String", "string");
testScalar($data1_value1, "Value", "value");
is( $query->GetXML(), "method_namevaluevaluevaluevaluevaluevaluevaluevaluenamebase64booleandatetimedoublei4intstringvaluebase64booleandatetimedoublei4intstringvalue", "GetXML()" );
my $methodResponse = $query->AddMethodResponse();
ok( defined($methodResponse), "new()" );
isa_ok( $methodResponse, "Net::Jabber::Stanza" );
isa_ok( $methodResponse, "Net::XMPP::Stanza" );
my $params2 = $methodResponse->AddParams();
ok( defined($params2), "new()" );
isa_ok( $params2, "Net::Jabber::Stanza" );
isa_ok( $params2, "Net::XMPP::Stanza" );
my $param2 = $params2->AddParam();
ok( defined($param2), "new()" );
isa_ok( $param2, "Net::Jabber::Stanza" );
isa_ok( $param2, "Net::XMPP::Stanza" );
my $value2_1 = $param2->AddValue();
ok( defined($value2_1), "new()" );
isa_ok( $value2_1, "Net::Jabber::Stanza" );
isa_ok( $value2_1, "Net::XMPP::Stanza" );
testScalar($value2_1, "Base64", "value");
testScalar($value2_1, "Boolean", "value");
testScalar($value2_1, "DateTime", "value");
testScalar($value2_1, "Double", "value");
testScalar($value2_1, "I4", "value");
testScalar($value2_1, "Int", "value");
testScalar($value2_1, "String", "value");
testScalar($value2_1, "Value", "value");
my $struct2 = $value2_1->AddStruct();
my $member2 = $struct2->AddMember();
ok( defined($member2), "new()" );
isa_ok( $member2, "Net::Jabber::Stanza" );
isa_ok( $member2, "Net::XMPP::Stanza" );
testScalar($member2, "Name", "name");
my $member2_value1 = $member2->AddValue();
ok( defined($member2_value1), "new()" );
isa_ok( $member2_value1, "Net::Jabber::Stanza" );
isa_ok( $member2_value1, "Net::XMPP::Stanza" );
testScalar($member2_value1, "Base64", "base64");
testScalar($member2_value1, "Boolean", "boolean");
testScalar($member2_value1, "DateTime", "datetime");
testScalar($member2_value1, "Double", "double");
testScalar($member2_value1, "I4", "i4");
testScalar($member2_value1, "Int", "int");
testScalar($member2_value1, "String", "string");
testScalar($member2_value1, "Value", "value");
my $array2 = $value2_1->AddArray();
my $data2 = $array2->AddData();
ok( defined($data2), "new()" );
isa_ok( $data2, "Net::Jabber::Stanza" );
isa_ok( $data2, "Net::XMPP::Stanza" );
my $data2_value1 = $data2->AddValue();
ok( defined($data2_value1), "new()" );
isa_ok( $data2_value1, "Net::Jabber::Stanza" );
isa_ok( $data2_value1, "Net::XMPP::Stanza" );
testScalar($data2_value1, "Base64", "base64");
testScalar($data2_value1, "Boolean", "boolean");
testScalar($data2_value1, "DateTime", "datetime");
testScalar($data2_value1, "Double", "double");
testScalar($data2_value1, "I4", "i4");
testScalar($data2_value1, "Int", "int");
testScalar($data2_value1, "String", "string");
testScalar($data2_value1, "Value", "value");
my $fault1 = $methodResponse->AddFault();
ok( defined($fault1), "new()" );
isa_ok( $fault1, "Net::Jabber::Stanza" );
isa_ok( $fault1, "Net::XMPP::Stanza" );
my $faultStruct = $fault1->AddValue()->AddStruct();
ok( defined($faultStruct), "new()" );
isa_ok( $faultStruct, "Net::Jabber::Stanza" );
isa_ok( $faultStruct, "Net::XMPP::Stanza" );
$faultStruct->AddMember(name=>"faultCode")->AddValue(i4=>404);
$faultStruct->AddMember(name=>"faultString")->AddValue(string=>"not found");
is( $query->GetXML(), "method_namevaluevaluevaluevaluevaluevaluevaluevaluenamebase64booleandatetimedoublei4intstringvaluebase64booleandatetimedoublei4intstringvaluevaluevaluevaluevaluevaluevaluevaluevaluenamebase64booleandatetimedoublei4intstringvaluebase64booleandatetimedoublei4intstringvaluefaultCode404faultStringnot found", "GetXML()" );
Net-Jabber-2.0/t/lib/ 0002755 0001750 0001750 00000000000 10112242736 015431 5 ustar reatmon reatmon 0000000 0000000 Net-Jabber-2.0/t/lib/Test/ 0002755 0001750 0001750 00000000000 10112242737 016351 5 ustar reatmon reatmon 0000000 0000000 Net-Jabber-2.0/t/lib/Test/Simple.pm 0000644 0001750 0001750 00000014565 10110275744 020153 0 ustar reatmon reatmon 0000000 0000000 package Test::Simple;
use 5.004;
use strict 'vars';
use vars qw($VERSION);
$VERSION = '0.47';
use Test::Builder;
my $Test = Test::Builder->new;
sub import {
my $self = shift;
my $caller = caller;
*{$caller.'::ok'} = \&ok;
$Test->exported_to($caller);
$Test->plan(@_);
}
=head1 NAME
Test::Simple - Basic utilities for writing tests.
=head1 SYNOPSIS
use Test::Simple tests => 1;
ok( $foo eq $bar, 'foo is bar' );
=head1 DESCRIPTION
** If you are unfamiliar with testing B first! **
This is an extremely simple, extremely basic module for writing tests
suitable for CPAN modules and other pursuits. If you wish to do more
complicated testing, use the Test::More module (a drop-in replacement
for this one).
The basic unit of Perl testing is the ok. For each thing you want to
test your program will print out an "ok" or "not ok" to indicate pass
or fail. You do this with the ok() function (see below).
The only other constraint is you must pre-declare how many tests you
plan to run. This is in case something goes horribly wrong during the
test and your test program aborts, or skips a test or whatever. You
do this like so:
use Test::Simple tests => 23;
You must have a plan.
=over 4
=item B
ok( $foo eq $bar, $name );
ok( $foo eq $bar );
ok() is given an expression (in this case C<$foo eq $bar>). If it's
true, the test passed. If it's false, it didn't. That's about it.
ok() prints out either "ok" or "not ok" along with a test number (it
keeps track of that for you).
# This produces "ok 1 - Hell not yet frozen over" (or not ok)
ok( get_temperature($hell) > 0, 'Hell not yet frozen over' );
If you provide a $name, that will be printed along with the "ok/not
ok" to make it easier to find your test when if fails (just search for
the name). It also makes it easier for the next guy to understand
what your test is for. It's highly recommended you use test names.
All tests are run in scalar context. So this:
ok( @stuff, 'I have some stuff' );
will do what you mean (fail if stuff is empty)
=cut
sub ok ($;$) {
$Test->ok(@_);
}
=back
Test::Simple will start by printing number of tests run in the form
"1..M" (so "1..5" means you're going to run 5 tests). This strange
format lets Test::Harness know how many tests you plan on running in
case something goes horribly wrong.
If all your tests passed, Test::Simple will exit with zero (which is
normal). If anything failed it will exit with how many failed. If
you run less (or more) tests than you planned, the missing (or extras)
will be considered failures. If no tests were ever run Test::Simple
will throw a warning and exit with 255. If the test died, even after
having successfully completed all its tests, it will still be
considered a failure and will exit with 255.
So the exit codes are...
0 all tests successful
255 test died
any other number how many failed (including missing or extras)
If you fail more than 254 tests, it will be reported as 254.
This module is by no means trying to be a complete testing system.
It's just to get you started. Once you're off the ground its
recommended you look at L.
=head1 EXAMPLE
Here's an example of a simple .t file for the fictional Film module.
use Test::Simple tests => 5;
use Film; # What you're testing.
my $btaste = Film->new({ Title => 'Bad Taste',
Director => 'Peter Jackson',
Rating => 'R',
NumExplodingSheep => 1
});
ok( defined($btaste) and ref $btaste eq 'Film', 'new() works' );
ok( $btaste->Title eq 'Bad Taste', 'Title() get' );
ok( $btaste->Director eq 'Peter Jackson', 'Director() get' );
ok( $btaste->Rating eq 'R', 'Rating() get' );
ok( $btaste->NumExplodingSheep == 1, 'NumExplodingSheep() get' );
It will produce output like this:
1..5
ok 1 - new() works
ok 2 - Title() get
ok 3 - Director() get
not ok 4 - Rating() get
# Failed test (t/film.t at line 14)
ok 5 - NumExplodingSheep() get
# Looks like you failed 1 tests of 5
Indicating the Film::Rating() method is broken.
=head1 CAVEATS
Test::Simple will only report a maximum of 254 failures in its exit
code. If this is a problem, you probably have a huge test script.
Split it into multiple files. (Otherwise blame the Unix folks for
using an unsigned short integer as the exit status).
Because VMS's exit codes are much, much different than the rest of the
universe, and perl does horrible mangling to them that gets in my way,
it works like this on VMS.
0 SS$_NORMAL all tests successful
4 SS$_ABORT something went wrong
Unfortunately, I can't differentiate any further.
=head1 NOTES
Test::Simple is B tested all the way back to perl 5.004.
Test::Simple is thread-safe in perl 5.8.0 and up.
=head1 HISTORY
This module was conceived while talking with Tony Bowden in his
kitchen one night about the problems I was having writing some really
complicated feature into the new Testing module. He observed that the
main problem is not dealing with these edge cases but that people hate
to write tests B. What was needed was a dead simple module
that took all the hard work out of testing and was really, really easy
to learn. Paul Johnson simultaneously had this idea (unfortunately,
he wasn't in Tony's kitchen). This is it.
=head1 SEE ALSO
=over 4
=item L
More testing functions! Once you outgrow Test::Simple, look at
Test::More. Test::Simple is 100% forward compatible with Test::More
(i.e. you can just use Test::More instead of Test::Simple in your
programs and things will still work).
=item L
The original Perl testing module.
=item L
Elaborate unit testing.
=item L, L
Embed tests in your code!
=item L
Interprets the output of your test program.
=back
=head1 AUTHORS
Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
Eschwern@pobox.comE, wardrobe by Calvin Klein.
=head1 COPYRIGHT
Copyright 2001 by Michael G Schwern Eschwern@pobox.comE.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F
=cut
1;
Net-Jabber-2.0/t/lib/Test/Builder.pm 0000644 0001750 0001750 00000073773 10110275744 020316 0 ustar reatmon reatmon 0000000 0000000 package Test::Builder;
use 5.004;
# $^C was only introduced in 5.005-ish. We do this to prevent
# use of uninitialized value warnings in older perls.
$^C ||= 0;
use strict;
use vars qw($VERSION $CLASS);
$VERSION = '0.17';
$CLASS = __PACKAGE__;
my $IsVMS = $^O eq 'VMS';
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
if( $] >= 5.008 && $Config{useithreads} ) {
require threads;
require threads::shared;
threads::shared->import;
}
else {
*share = sub { 0 };
*lock = sub { 0 };
}
}
use vars qw($Level);
my($Test_Died) = 0;
my($Have_Plan) = 0;
my $Original_Pid = $$;
my $Curr_Test = 0; share($Curr_Test);
my @Test_Results = (); share(@Test_Results);
my @Test_Details = (); share(@Test_Details);
=head1 NAME
Test::Builder - Backend for building test libraries
=head1 SYNOPSIS
package My::Test::Module;
use Test::Builder;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(ok);
my $Test = Test::Builder->new;
$Test->output('my_logfile');
sub import {
my($self) = shift;
my $pack = caller;
$Test->exported_to($pack);
$Test->plan(@_);
$self->export_to_level(1, $self, 'ok');
}
sub ok {
my($test, $name) = @_;
$Test->ok($test, $name);
}
=head1 DESCRIPTION
Test::Simple and Test::More have proven to be popular testing modules,
but they're not always flexible enough. Test::Builder provides the a
building block upon which to write your own test libraries I.
=head2 Construction
=over 4
=item B
my $Test = Test::Builder->new;
Returns a Test::Builder object representing the current state of the
test.
Since you only run one test per program, there is B
Test::Builder object. No matter how many times you call new(), you're
getting the same object. (This is called a singleton).
=cut
my $Test;
sub new {
my($class) = shift;
$Test ||= bless ['Move along, nothing to see here'], $class;
return $Test;
}
=back
=head2 Setting up tests
These methods are for setting up tests and declaring how many there
are. You usually only want to call one of these methods.
=over 4
=item B
my $pack = $Test->exported_to;
$Test->exported_to($pack);
Tells Test::Builder what package you exported your functions to.
This is important for getting TODO tests right.
=cut
my $Exported_To;
sub exported_to {
my($self, $pack) = @_;
if( defined $pack ) {
$Exported_To = $pack;
}
return $Exported_To;
}
=item B
$Test->plan('no_plan');
$Test->plan( skip_all => $reason );
$Test->plan( tests => $num_tests );
A convenient way to set up your tests. Call this and Test::Builder
will print the appropriate headers and take the appropriate actions.
If you call plan(), don't call any of the other methods below.
=cut
sub plan {
my($self, $cmd, $arg) = @_;
return unless $cmd;
if( $Have_Plan ) {
die sprintf "You tried to plan twice! Second plan at %s line %d\n",
($self->caller)[1,2];
}
if( $cmd eq 'no_plan' ) {
$self->no_plan;
}
elsif( $cmd eq 'skip_all' ) {
return $self->skip_all($arg);
}
elsif( $cmd eq 'tests' ) {
if( $arg ) {
return $self->expected_tests($arg);
}
elsif( !defined $arg ) {
die "Got an undefined number of tests. Looks like you tried to ".
"say how many tests you plan to run but made a mistake.\n";
}
elsif( !$arg ) {
die "You said to run 0 tests! You've got to run something.\n";
}
}
else {
require Carp;
my @args = grep { defined } ($cmd, $arg);
Carp::croak("plan() doesn't understand @args");
}
return 1;
}
=item B
my $max = $Test->expected_tests;
$Test->expected_tests($max);
Gets/sets the # of tests we expect this test to run and prints out
the appropriate headers.
=cut
my $Expected_Tests = 0;
sub expected_tests {
my($self, $max) = @_;
if( defined $max ) {
$Expected_Tests = $max;
$Have_Plan = 1;
$self->_print("1..$max\n") unless $self->no_header;
}
return $Expected_Tests;
}
=item B
$Test->no_plan;
Declares that this test will run an indeterminate # of tests.
=cut
my($No_Plan) = 0;
sub no_plan {
$No_Plan = 1;
$Have_Plan = 1;
}
=item B
$plan = $Test->has_plan
Find out whether a plan has been defined. $plan is either C (no plan has been set), C (indeterminate # of tests) or an integer (the number of expected tests).
=cut
sub has_plan {
return($Expected_Tests) if $Expected_Tests;
return('no_plan') if $No_Plan;
return(undef);
};
=item B
$Test->skip_all;
$Test->skip_all($reason);
Skips all the tests, using the given $reason. Exits immediately with 0.
=cut
my $Skip_All = 0;
sub skip_all {
my($self, $reason) = @_;
my $out = "1..0";
$out .= " # Skip $reason" if $reason;
$out .= "\n";
$Skip_All = 1;
$self->_print($out) unless $self->no_header;
exit(0);
}
=back
=head2 Running tests
These actually run the tests, analogous to the functions in
Test::More.
$name is always optional.
=over 4
=item B
$Test->ok($test, $name);
Your basic test. Pass if $test is true, fail if $test is false. Just
like Test::Simple's ok().
=cut
sub ok {
my($self, $test, $name) = @_;
# $test might contain an object which we don't want to accidentally
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
}
lock $Curr_Test;
$Curr_Test++;
$self->diag(<caller;
my $todo = $self->todo($pack);
my $out;
my $result = {};
share($result);
unless( $test ) {
$out .= "not ";
@$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
}
else {
@$result{ 'ok', 'actual_ok' } = ( 1, $test );
}
$out .= "ok";
$out .= " $Curr_Test" if $self->use_numbers;
if( defined $name ) {
$name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
$out .= " - $name";
$result->{name} = $name;
}
else {
$result->{name} = '';
}
if( $todo ) {
my $what_todo = $todo;
$out .= " # TODO $what_todo";
$result->{reason} = $what_todo;
$result->{type} = 'todo';
}
else {
$result->{reason} = '';
$result->{type} = '';
}
$Test_Results[$Curr_Test-1] = $result;
$out .= "\n";
$self->_print($out);
unless( $test ) {
my $msg = $todo ? "Failed (TODO)" : "Failed";
$self->diag(" $msg test ($file at line $line)\n");
}
return $test ? 1 : 0;
}
=item B
$Test->is_eq($got, $expected, $name);
Like Test::More's is(). Checks if $got eq $expected. This is the
string version.
=item B
$Test->is_num($got, $expected, $name);
Like Test::More's is(). Checks if $got == $expected. This is the
numeric version.
=cut
sub is_eq {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, 'eq', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'eq', $expect, $name);
}
sub is_num {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, '==', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '==', $expect, $name);
}
sub _is_diag {
my($self, $got, $type, $expect) = @_;
foreach my $val (\$got, \$expect) {
if( defined $$val ) {
if( $type eq 'eq' ) {
# quote and force string context
$$val = "'$$val'"
}
else {
# force numeric context
$$val = $$val+0;
}
}
else {
$$val = 'undef';
}
}
return $self->diag(sprintf <
$Test->isnt_eq($got, $dont_expect, $name);
Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
the string version.
=item B
$Test->is_num($got, $dont_expect, $name);
Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
the numeric version.
=cut
sub isnt_eq {
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag('ne', $got, $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'ne', $dont_expect, $name);
}
sub isnt_num {
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag('!=', $got, $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '!=', $dont_expect, $name);
}
=item B
$Test->like($this, qr/$regex/, $name);
$Test->like($this, '/$regex/', $name);
Like Test::More's like(). Checks if $this matches the given $regex.
You'll want to avoid qr// if you want your tests to work before 5.005.
=item B
$Test->unlike($this, qr/$regex/, $name);
$Test->unlike($this, '/$regex/', $name);
Like Test::More's unlike(). Checks if $this B the
given $regex.
=cut
sub like {
my($self, $this, $regex, $name) = @_;
local $Level = $Level + 1;
$self->_regex_ok($this, $regex, '=~', $name);
}
sub unlike {
my($self, $this, $regex, $name) = @_;
local $Level = $Level + 1;
$self->_regex_ok($this, $regex, '!~', $name);
}
=item B
$Test->maybe_regex(qr/$regex/);
$Test->maybe_regex('/$regex/');
Convenience method for building testing functions that take regular
expressions as arguments, but need to work before perl 5.005.
Takes a quoted regular expression produced by qr//, or a string
representing a regular expression.
Returns a Perl value which may be used instead of the corresponding
regular expression, or undef if it's argument is not recognised.
For example, a version of like(), sans the useful diagnostic messages,
could be written as:
sub laconic_like {
my ($self, $this, $regex, $name) = @_;
my $usable_regex = $self->maybe_regex($regex);
die "expecting regex, found '$regex'\n"
unless $usable_regex;
$self->ok($this =~ m/$usable_regex/, $name);
}
=cut
sub maybe_regex {
my ($self, $regex) = @_;
my $usable_regex = undef;
if( ref $regex eq 'Regexp' ) {
$usable_regex = $regex;
}
# Check if it looks like '/foo/'
elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
$usable_regex = length $opts ? "(?$opts)$re" : $re;
};
return($usable_regex)
};
sub _regex_ok {
my($self, $this, $regex, $cmp, $name) = @_;
local $Level = $Level + 1;
my $ok = 0;
my $usable_regex = $self->maybe_regex($regex);
unless (defined $usable_regex) {
$ok = $self->ok( 0, $name );
$self->diag(" '$regex' doesn't look much like a regex to me.");
return $ok;
}
{
local $^W = 0;
my $test = $this =~ /$usable_regex/ ? 1 : 0;
$test = !$test if $cmp eq '!~';
$ok = $self->ok( $test, $name );
}
unless( $ok ) {
$this = defined $this ? "'$this'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
$self->diag(sprintf <
$Test->cmp_ok($this, $type, $that, $name);
Works just like Test::More's cmp_ok().
$Test->cmp_ok($big_num, '!=', $other_big_num);
=cut
sub cmp_ok {
my($self, $got, $type, $expect, $name) = @_;
my $test;
{
local $^W = 0;
local($@,$!); # don't interfere with $@
# eval() sometimes resets $!
$test = eval "\$got $type \$expect";
}
local $Level = $Level + 1;
my $ok = $self->ok($test, $name);
unless( $ok ) {
if( $type =~ /^(eq|==)$/ ) {
$self->_is_diag($got, $type, $expect);
}
else {
$self->_cmp_diag($got, $type, $expect);
}
}
return $ok;
}
sub _cmp_diag {
my($self, $got, $type, $expect) = @_;
$got = defined $got ? "'$got'" : 'undef';
$expect = defined $expect ? "'$expect'" : 'undef';
return $self->diag(sprintf <
$Test->BAILOUT($reason);
Indicates to the Test::Harness that things are going so badly all
testing should terminate. This includes running any additional test
scripts.
It will exit with 255.
=cut
sub BAILOUT {
my($self, $reason) = @_;
$self->_print("Bail out! $reason");
exit 255;
}
=item B
$Test->skip;
$Test->skip($why);
Skips the current test, reporting $why.
=cut
sub skip {
my($self, $why) = @_;
$why ||= '';
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
lock($Curr_Test);
$Curr_Test++;
my %result;
share(%result);
%result = (
'ok' => 1,
actual_ok => 1,
name => '',
type => 'skip',
reason => $why,
);
$Test_Results[$Curr_Test-1] = \%result;
my $out = "ok";
$out .= " $Curr_Test" if $self->use_numbers;
$out .= " # skip $why\n";
$Test->_print($out);
return 1;
}
=item B
$Test->todo_skip;
$Test->todo_skip($why);
Like skip(), only it will declare the test as failing and TODO. Similar
to
print "not ok $tnum # TODO $why\n";
=cut
sub todo_skip {
my($self, $why) = @_;
$why ||= '';
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
lock($Curr_Test);
$Curr_Test++;
my %result;
share(%result);
%result = (
'ok' => 1,
actual_ok => 0,
name => '',
type => 'todo_skip',
reason => $why,
);
$Test_Results[$Curr_Test-1] = \%result;
my $out = "not ok";
$out .= " $Curr_Test" if $self->use_numbers;
$out .= " # TODO & SKIP $why\n";
$Test->_print($out);
return 1;
}
=begin _unimplemented
=item B
$Test->skip_rest;
$Test->skip_rest($reason);
Like skip(), only it skips all the rest of the tests you plan to run
and terminates the test.
If you're running under no_plan, it skips once and terminates the
test.
=end _unimplemented
=back
=head2 Test style
=over 4
=item B
$Test->level($how_high);
How far up the call stack should $Test look when reporting where the
test failed.
Defaults to 1.
Setting $Test::Builder::Level overrides. This is typically useful
localized:
{
local $Test::Builder::Level = 2;
$Test->ok($test);
}
=cut
sub level {
my($self, $level) = @_;
if( defined $level ) {
$Level = $level;
}
return $Level;
}
$CLASS->level(1);
=item B
$Test->use_numbers($on_or_off);
Whether or not the test should output numbers. That is, this if true:
ok 1
ok 2
ok 3
or this if false
ok
ok
ok
Most useful when you can't depend on the test output order, such as
when threads or forking is involved.
Test::Harness will accept either, but avoid mixing the two styles.
Defaults to on.
=cut
my $Use_Nums = 1;
sub use_numbers {
my($self, $use_nums) = @_;
if( defined $use_nums ) {
$Use_Nums = $use_nums;
}
return $Use_Nums;
}
=item B
$Test->no_header($no_header);
If set to true, no "1..N" header will be printed.
=item B
$Test->no_ending($no_ending);
Normally, Test::Builder does some extra diagnostics when the test
ends. It also changes the exit code as described in Test::Simple.
If this is true, none of that will be done.
=cut
my($No_Header, $No_Ending) = (0,0);
sub no_header {
my($self, $no_header) = @_;
if( defined $no_header ) {
$No_Header = $no_header;
}
return $No_Header;
}
sub no_ending {
my($self, $no_ending) = @_;
if( defined $no_ending ) {
$No_Ending = $no_ending;
}
return $No_Ending;
}
=back
=head2 Output
Controlling where the test output goes.
It's ok for your test to change where STDOUT and STDERR point to,
Test::Builder's default output settings will not be affected.
=over 4
=item B
$Test->diag(@msgs);
Prints out the given $message. Normally, it uses the failure_output()
handle, but if this is for a TODO test, the todo_output() handle is
used.
Output will be indented and marked with a # so as not to interfere
with test output. A newline will be put on the end if there isn't one
already.
We encourage using this rather than calling print directly.
Returns false. Why? Because diag() is often used in conjunction with
a failing test (C) it "passes through" the failure.
return ok(...) || diag(...);
=for blame transfer
Mark Fowler
=cut
sub diag {
my($self, @msgs) = @_;
return unless @msgs;
# Prevent printing headers when compiling (i.e. -c)
return if $^C;
# Escape each line with a #.
foreach (@msgs) {
$_ = 'undef' unless defined;
s/^/# /gms;
}
push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
local $Level = $Level + 1;
my $fh = $self->todo ? $self->todo_output : $self->failure_output;
local($\, $", $,) = (undef, ' ', '');
print $fh @msgs;
return 0;
}
=begin _private
=item B<_print>
$Test->_print(@msgs);
Prints to the output() filehandle.
=end _private
=cut
sub _print {
my($self, @msgs) = @_;
# Prevent printing headers when only compiling. Mostly for when
# tests are deparsed with B::Deparse
return if $^C;
local($\, $", $,) = (undef, ' ', '');
my $fh = $self->output;
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
foreach (@msgs) {
s/\n(.)/\n# $1/sg;
}
push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
print $fh @msgs;
}
=item B