Jabber-RPC

 view release on metacpan or  search on metacpan

examples/client.pl  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use Jabber::RPC::Client;

my $client = new Jabber::RPC::Client(
  server    => 'localhost',
  identauth => 'dj:password',
  resource  => 'the-client',
# endpoint  => 'a@localhost/the-server',
  endpoint  => 'jrpc.localhost/the-server',
);

my $result;

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

$result = $client->call('examples.getStateList', [12, 28, 33, 39, 46]);
print "getStateList: ", $result || $client->lastfault, "\n";

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

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

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

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;

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

  # 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;

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

  # 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 {