view release on metacpan or  search on metacpan

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

# Jabber-RPC: Client Functions
# (c) DJ Adams 2001

# $Id: Client.pm,v 1.1.1.1 2001/09/24 11:23:02 dj Exp $

=head1 NAME

Jabber::RPC::Client - Jabber-RPC Client

=head1 SYNOPSIS

  use Jabber::RPC::Client;

  # Client connects as Jabber client
  my $client = new Jabber::RPC::Client(
    server    => 'myserver.org',
    identauth => 'user:password',
    endpoint  => 'jrpc.myserver.org/rpc-server',
  );  

  my $result = $client->call('examples.getStateName', 5);
  print "getStateName: ", $result || $client->lastfault, "\n";

  # Switch endpoints
  $client->endpoint('another@endpoint.org/resource');
  
  # This time the call will go to the new endpoint
  my $result = $client->call('examples.getStateList', [12,13,14]);
  print "getStateList: ", $result || $client->lastfault, "\n";

=head1 DESCRIPTION

Jabber::RPC::Client is an implementation of a Jabber-RPC client.
A Jabber-RPC client sends XML-RPC-encoded calls carried over
Jabber to an endpoint that is a Jabber::RPC::Server. 

It uses the Frontier::RPC2 XML-RPC implementation to make the
encoding and decoding calls.

The endpoint can either be a Jabber component or a Jabber client
(see the SYNOPSIS examples for Jabber::RPC::Server) - specify the
JID of the endpoint appropriately.

You can change the endpoint with the endpoint() function. 

If you don't specify any value for a 'resource' argument, a default
of 'jrpc-client' will be used. Bear in mind that if you haven't 
specified a value for the 'resource' argument when starting the
Jabber::RPC::Server, a default of 'jrpc-server' will be used there.
Hence the endpoint of 'jrpc.myserver.org/rpc-server' in the 
synopsis example above.

=head1 VERSION

early

=head1 AUTHOR

DJ Adams

=head1 SEE ALSO

Jabber::RPC::Server, Jabber::Connection

=cut

package Jabber::RPC::Client;

use Frontier::RPC2;
use Jabber::Connection;
use Jabber::NodeFactory;
use Jabber::NS qw(:all);

use constant RESOURCE => 'jrpc-client';

use vars qw/$AUTOLOAD/;

use strict;

sub new {

  # to be supplied
  # server : jabber server:port e.g. merlix:5222
  # identauth : user:password e.g. dj:secret
  # endpoint : target Jabber-RPC responder
  # resource: the resource to connect with (optional)
 
  my $class = shift; my %args = @_;
  my $self = {};

  # My (the client's) host/port and Identity
  $self->{server} = $args{server};
  ($self->{id}, $self->{pass}) = split(':', $args{identauth});

  # Target XMLRPC server
  $self->{endpoint} = $args{endpoint};

  # Connect to Jabber
  $self->{connection} = new Jabber::Connection(
    server    => $self->{server},
#   log       => 1,
#   debug     => 1,
  );

  $self->{connection}->connect
      or  die "oops: ".$self->{connection}->lastError;

  $self->{connection}->auth($self->{id}, $self->{pass}, $args{resource} || RESOURCE);

  # XMLRPC server
  $self->{RPC2} = new Frontier::RPC2;

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

  bless $self, $class;
  return $self;
 
}

sub call {

  my $self = shift;

  # Clear last fault info, results and results
  delete $self->{lastfault};

  # Create XML call payload
  my $request = $self->{RPC2}->encode_call(@_);
  $request =~ s/^<\?[^>]+>\n//; # remove XML declaration

  # Create an IQ
  my $set = $self->{nf}->newNode('iq');
  $set->attr('type', IQ_SET);
  $set->attr('to', $self->{endpoint});
  $set->insertTag('query', NS_RPC)->rawdata($request);

  # Send it
  my $result = $self->{connection}->ask($set);

  # Check for error 
  if ($result->attr('type') eq IQ_ERROR) {
    my $error = $result->getTag('error');
    $self->{lastfault} = $error->data." (".$error->attr('code').")";
    return;
  }

  # Extract the response
  my $response = $result->getTag('query', NS_RPC)->getTag('methodResponse');

  my $struct = $self->{RPC2}->decode($response->toStr);
  return $struct->{'value'}[0];

}


sub endpoint {

  my $self = shift;
  $self->{endpoint} = $_[0] if $_[0];
  return $self->{endpoint};

}


sub DESTROY {
  my $self = shift;
  $self->{connection}->disconnect;
}

sub AUTOLOAD {
  # Not sure I really want this...
  my $self = shift;
  $AUTOLOAD =~ s/^.*:://;
  return if $AUTOLOAD eq "DESTROY"; # bzzt!

  my %functions = (
    'base64'    => 'Base64',
    'boolean'   => 'Boolean',
    'double'    => 'Double',
    'int'       => 'Integer',
    'string'    => 'String',
    'date_time' => 'DateTime',
  );

  return unless defined($functions{$AUTOLOAD});

  my $retval;
  eval "\$retval = new Frontier::RPC2::".$functions{$AUTOLOAD}."(\@_)";

  return $retval;
}


sub lastfault {

  my $self = shift;
  return $self->{'lastfault'};

}

1;