view release on metacpan or  search on metacpan

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

  $self->{_num};
}

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

package SOAP::Test::Server;

use strict;
use Test;
use SOAP::Lite;

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

  # ------------------------------------------------------
  my $s = SOAP::Lite->uri('http://something/somewhere')->proxy($proxy)->on_fault(sub{});
  eval { $s->transport->timeout($SOAP::Test::TIMEOUT) };
  my $r = $s->test_connection;

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

  plan tests => 53;

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

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

  $s = SOAP::Lite
    -> uri('urn:/My/Examples')
      -> proxy($proxy);

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

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

  $r = $s->getStateStruct({item1 => 1, item2 => 4})->result;
  ok(ref $r && $r->{item2} eq 'Arkansas');
print $s->transport->status, "\n";
  {
    my $autoresult = $s->autoresult;
    $s->autoresult(1);
    ok($s->getStateName(1) eq 'Alabama');
    $s->autoresult($autoresult);
  }

  print STDERR "Autobinding of output parameters test(s)...\n";

  $s->uri('urn:/My/Parameters');
  my $param1 = 10;
  my $param2 = SOAP::Data->name('myparam' => 12);
  my $result = $s->autobind($param1, $param2)->result;
  ok($result == $param1 && $param2->value == 24);

  print STDERR "Header manipulation test(s)...\n";
  $a = $s->addheader(2, SOAP::Header->name(my => 123));
  ok(ref $a->header && $a->header->{my} eq '123123');
  ok($a->headers eq '123123');

  print STDERR "Echo untyped data test(s)...\n";
  $a = $s->echotwo(11, 12);
  ok($a->result == 11);

  print STDERR "mustUnderstand test(s)...\n";
  $s->echo(SOAP::Header->name(somethingelse => 123)
                       ->mustUnderstand(1));
  ok($s->call->faultstring =~ /[Hh]eader has mustUnderstand attribute/);

  if ($proxy =~ /^http/) {
    ok($s->transport->status =~ /^500/);
  } else {
    skip('No Status checks for non http protocols on server side' => undef);
  }

  $s->echo(SOAP::Header->name(somethingelse => 123)
                       ->mustUnderstand(1)
                       ->actor('http://notme/'));
  ok(!defined $s->call->fault);

  print STDERR "dispatch_from test(s)...\n";
  eval "use SOAP::Lite
    uri => 'http://my.own.site.com/My/Examples',
    dispatch_from => ['A', 'B'],
    proxy => '$proxy',
  ; 1" or die;

  eval { C->c };
  ok($@ =~ /Can't locate object method "c"/);

  eval { A->a };
  ok(!$@ && SOAP::Lite->self->call->faultstring =~ /Failed to access class \(A\)/);

  eval "use SOAP::Lite
    dispatch_from => 'A',
    uri => 'http://my.own.site.com/My/Examples',
    proxy => '$proxy',
  ; 1" or die;

  eval { A->a };
  ok(!$@ && SOAP::Lite->self->call->faultstring =~ /Failed to access class \(A\)/);

  print STDERR "Object autobinding and SOAP:: prefix test(s)...\n";

  eval "use SOAP::Lite +autodispatch =>
    uri => 'urn:', proxy => '$proxy'; 1" or die;

  ok(SOAP::Lite->autodispatched);

  eval { SOAP->new(1) };
  ok($@ =~ /^URI is not specified/);

  eval "use SOAP::Lite +autodispatch =>
    uri => 'urn:/A/B', proxy => '$proxy'; 1" or die;

  # should call My::PingPong, not A::B
  my $p = My::PingPong->SOAP::new(10);
  ok(ref $p && $p->SOAP::next+1 == $p->value);

  # forget everything
  SOAP::Lite->self(undef);

  $s = SOAP::Lite
    -> uri('urn:/My/PingPong')
    -> proxy($proxy)
  ;

  # should return object EXACTLY as after My::PingPong->SOAP::new(10)
  $p = $s->SOAP::new(10);
  ok(ref $p && $s->SOAP::next($p)+1 == $p->value);

  print STDERR "VersionMismatch test(s)...\n";

  {
    local $SOAP::Constants::NS_ENV = 'http://schemas.xmlsoap.org/new/envelope/';
    my $s = SOAP::Lite