view release on metacpan or  search on metacpan

lib/XMLRPC/Test.pm  view on Meta::CPAN

# ======================================================================
#
# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com)
# SOAP::Lite is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# $Id$
#
# ======================================================================

package XMLRPC::Test;

use 5.004;
use vars qw($VERSION $TIMEOUT);
our $VERSION = 0.717;

$TIMEOUT = 5;

# ======================================================================

package My::PingPong; # we'll use this package in our tests

sub new {
  my $self = shift;
  my $class = ref($self) || $self;
  bless {_num=>shift} => $class;
}

sub next {
  my $self = shift;
  $self->{_num}++;
}

sub value {
  my $self = shift;
  $self->{_num};
}

# ======================================================================

package XMLRPC::Test::Server;

use strict;
use Test;
use XMLRPC::Lite;

sub run_for {
  my $proxy = shift or die "Proxy/endpoint is not specified";

  # ------------------------------------------------------
  my $s = XMLRPC::Lite->proxy($proxy)->on_fault(sub{});
  eval { $s->transport->timeout($XMLRPC::Test::TIMEOUT) };
  my $r = $s->test_connection;

  unless (defined $r && defined $r->envelope) {
    print "1..0 # Skip: ", $s->transport->status, "\n";
    exit;
  }
  # ------------------------------------------------------

  plan tests => 17;

  eval q!use XMLRPC::Lite on_fault => sub{ref $_[1] ? $_[1] : new XMLRPC::SOM}; 1! or die;

  print "Perl XMLRPC server test(s)...\n";

  $s = XMLRPC::Lite
    -> proxy($proxy)
  ;

  ok($s->call('My.Examples.getStateName', 1)->result eq 'Alabama');
  ok($s->call('My.Examples.getStateNames', 1,4,6,13)->result =~ /^Alabama\s+Arkansas\s+Colorado\s+Illinois\s*$/);

  $r = $s->call('My.Examples.getStateList', [1,2,3,4])->result;
  ok(ref $r && $r->[0] eq 'Alabama');

  $r = $s->call('My.Examples.getStateStruct', {item1 => 1, item2 => 4})->result;
  ok(ref $r && $r->{item2} eq 'Arkansas');

  print "dispatch_from test(s)...\n";
  eval "use XMLRPC::Lite
    dispatch_from => ['A', 'B'],
    proxy => '$proxy',
  ; 1" or die;

  eval { C->c };