view release on metacpan or  search on metacpan

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

    my $first = ($r->next, $r->next) if ref $r;

    $r = My::PersistentIterator->new(10);
    ok(ref $r && $r->next && $r->next == $first+2);
  } else {
    skip('No persistent objects (o-b-r) supported on server side' => undef);
  }

  { local $^W; # disable warnings about deprecated AUTOLOADing for nonmethods
    print STDERR "Parameters-by-name test(s)...\n";
    print STDERR "You can see warning about AUTOLOAD for non-method...\n" if $^W;

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

    my @parameters = (
      SOAP::Data->name(b => 222),
      SOAP::Data->name(c => 333),
      SOAP::Data->name(a => 111)
    );

    # switch to 'main' package, because nonqualified methods should be there
    ok(main::byname(@parameters) eq "a=111, b=222, c=333");

    ok(main::bynameororder(@parameters) eq "a=111, b=222, c=333");

    ok(main::bynameororder(111, 222, 333) eq "a=111, b=222, c=333");

    print STDERR "Function call test(s)...\n";
    print STDERR "You can see warning about AUTOLOAD for non-method...\n" if $^W;
    ok(main::echo(11) == 11);
  }

  print STDERR "SOAPAction test(s)...\n";
  if ($proxy =~ /^tcp:/) {
    for (1..2) {skip('No SOAPAction checks for tcp: protocol on server side' => undef)}
  } else {
    my $s = SOAP::Lite
      -> uri('http://my.own.site.com/My/Examples')
      -> proxy($proxy)
      -> on_action(sub{'""'})
    ;
    ok($s->getStateName(1)->result eq 'Alabama');

    $s->on_action(sub{'"wrong_SOAPAction_here"'});
    ok($s->getStateName(1)->faultstring =~ /SOAPAction shall match/);
  }

  print STDERR "UTF8 test(s)...\n";
  if (!eval "pack('U*', 0)") {
    for (1) {skip('No UTF8 test. No support for pack("U*") modifier' => undef)}
  } else {
    $s = SOAP::Lite
      -> uri('http://my.own.site.com/My/Parameters')
      -> proxy($proxy);

     my $latin1 = '�ਢ��';
     my $utf8 = pack('U*', unpack('C*', $latin1));
     my $result = $s->echo(SOAP::Data->type(string => $utf8))->result;

     ok(pack('U*', unpack('C*', $result)) eq $utf8                       # should work where XML::Parser marks resulting strings as UTF-8
     || join('', unpack('C*', $result)) eq join('', unpack('C*', $utf8)) # should work where it doesn't
     );
  }

  {
    my $on_fault_was_called = 0;
    print STDERR "Die in server method test(s)...\n";
    my $s = SOAP::Lite
      -> uri('http://my.own.site.com/My/Parameters')
      -> proxy($proxy)
      -> on_fault(sub{$on_fault_was_called++;return})
    ;
    ok($s->die_simply()->faultstring =~ /Something bad/);
    ok($on_fault_was_called > 0);
    my $detail = $s->die_with_object()->dataof(SOAP::SOM::faultdetail . '/[1]');
    ok($on_fault_was_called > 1);
    ok(ref $detail && $detail->name =~ /(^|:)something$/);

    # get Fault as hash of subelements
    my $fault = $s->die_with_fault()->fault;
    ok($fault->{faultcode} =~ ':Server.Custom');
    ok($fault->{faultstring} eq 'Died in server method');
    ok(ref $fault->{detail}->{BadError} eq 'BadError');
    ok($fault->{faultactor} eq 'http://www.soaplite.com/custom');
  }

  print STDERR "Method with attributes test(s)...\n";

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

  ok($s->call(SOAP::Data->name('getStateName')->attr({xmlns => 'urn:/My/Examples'}), 1)->result eq 'Alabama');

  print STDERR "Call with empty uri test(s)...\n";
  $s = SOAP::Lite
    -> uri('')
    -> proxy($proxy)
  ;

  ok($s->getStateName(1)->faultstring =~ /Denied access to method \(getStateName\) in class \(main\)/);

  ok($s->call('a:getStateName' => 1)->faultstring =~ /Denied access to method \(getStateName\) in class \(main\)/);

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

  $s = SOAP::Lite
    -> uri('http://my.own.site.com/My/Parameters')
    -> proxy($proxy)
  ;
  { my @all = $s->echo->paramsall; ok(@all == 0) }
  { my @all = $s->echo(1)->paramsall; ok(@all == 1) }
  { my @all = $s->echo((1) x 10)->paramsall; ok(@all == 10) }

  print STDERR "Memory refresh test(s)...\n";

  # Funny test.
  # Let's forget about ALL settings we did before with 'use SOAP::Lite...'
  SOAP::Lite->self(undef);