Jabber-RPC-HTTPgate

 view release on metacpan or  search on metacpan

lib/Jabber/RPC/HTTPgate.pm  view on Meta::CPAN


This is used to specify the name of the http component, and refers
to the value of the 'id' attribute in the http component's instance
definition in jabber.xml - see earlier for an example of this.

=back

=head1 VERSION

early

=head1 AUTHOR

DJ Adams

=head1 SEE ALSO

Jabber::RPC, Jabber::Connection

=cut

package Jabber::RPC::HTTPgate;

use strict;
use URI;
use Jabber::Connection;
use Jabber::NS qw(:all);

use vars qw($VERSION);

$VERSION = '0.01';

sub new {

  my $class = shift;
  my %args = @_;
  my $self = {};
  
  $self->{server} = $args{server};
  $self->{httpcomp} = $args{httpcomp};
  ($self->{id}, $self->{pass}) = split(':', $args{identauth});

  $self->{iq_requests} = { id => 1 };

  $self->{c} = new Jabber::Connection(
    server    => $self->{server},
    localname => $self->{id},
    ns        => NS_ACCEPT,
    log       => 1,
  );

  $self->{c}->register_handler('iq',    sub { $self->_reflect(@_) }      );
  $self->{c}->register_handler('iq',    sub { $self->_relay_result(@_) } );
  $self->{c}->register_handler('route', sub { $self->_handle_http(@_) }  );

  $self->{nf} = new Jabber::NodeFactory;

  $self->{c}->connect or die "Oops: ".$self->{c}->lastError;
  $self->{c}->auth($self->{pass});

  bless $self => $class;
  return $self;

}

sub start {

  my $self = shift;
  $self->{c}->start;

}



sub _reflect {

  my $self = shift;
  my $node = shift;

  # Ignore irrelevant packets. What we want is
  # an IQ-set with a jabber:iq:rpc qualified NS
  return unless $node->attr('type') eq IQ_SET
            and my $query = $node->getTag('query', NS_RPC);

  my $request = $query->getTag('methodCall')->toStr;
# my $request = $node->getTag('query', NS_RPC)->getTag('methodCall')->toStr;

  # We need to create a route packet to the http component
  # that looks like this:
  # 
  # <route type='request' to='http' from='id@component'>
  #   <http type='post' to='www.server.com' port='80' path='/RPC2'>
  #     <body>
  #     the payload
  #     </body>
  #   </http>
  # </route>

  # Store the request addresses
  # (we want to refer to this in handle_response())
  $self->{iq_requests}->{++$self->{iq_requests}->{id}} = {
                                 'from' => $node->attr('from'),
                                 'to'   => $node->attr('to'),
                                 'id'   => $node->attr('id'),
                               };

  my $route = $self->{nf}->newNode('route');
  $route->attr('type', 'request');
  $route->attr('to', $self->{httpcomp});
  $route->attr('from', join('@', $self->{iq_requests}->{id}, $self->{id}));

  # Resource should contain the URL
  my (undef, undef, $r) = _parseJID($node->attr('to'));

  # Split up URL
  my $uri = new URI($r);

  my $http = $route->insertTag('http');
  $http->attr('type', 'post');
  $http->attr('to', $uri->host);
  $http->attr('port', $uri->port) if $uri->port;

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 0.988 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )