libnet-jabber-perl 2.0-8 / usr / share / perl5 / Net / Jabber / Protocol.pm

##############################################################################
#
#  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("<tag>XML</tag>");
    $receiveObj = $Con->SendAndReceiveWithID($sendObj);
    $receiveObj = $Con->SendAndReceiveWithID($sendObj,
                                             10);
    $receiveObj = $Con->SendAndReceiveWithID("<tag>XML</tag>");
    $receiveObj = $Con->SendAndReceiveWithID("<tag>XML</tag>",
                                             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 <iq/> 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{<JID>}->{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
                                        <methodName/> and is case
                                        sensitive.  The single
                                        arguemnt is a ref to an
                                        array that contains the
                                        <params/>.  The function you
                                        write should return one of two
                                        things:

                                          ["ok", [...] ]

                                        The [...] is a list of the
                                        <params/> 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 <iq/> 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 arguments 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 (sort 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 <param/>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 <value/> 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 <struct/> 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 <array/> 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;