1package SOAP::Transport::CGI_TEST::Client;
2
3use strict; use warnings;
4use IPC::Open2;
5use File::Basename qw(dirname);
6
7# make a send_receive which performs an open2, much like a web server
8# connects to STDIN and STDOUT...
9sub send_receive {
10    my ($self, %parameters) = @_;
11    my ($context, $envelope, $endpoint, $action, $encoding, $parts) =
12        @parameters{qw(context envelope endpoint action encoding parts)};
13
14    # safety measure: Die if we hang
15    $SIG{ALRM} = sub { die "did not return" };
16    alarm(3);
17
18    my $perl = $^X;
19
20    my $dir = dirname(__FILE__);
21    my $cmd = "$dir/CGI/test_server.pl";
22
23    $ENV{'CONTENT_LENGTH'} = length($envelope);
24    $ENV{'REQUEST_METHOD'} = 'POST';
25    my($child_out, $child_in);
26    my $pid = open2($child_out, $child_in, $perl, '-Mblib', $cmd);
27    die "Cannot open $cmd: $!" if not ($pid);
28
29    print $child_in $envelope;
30    print $child_in "\n";
31    close $child_in;
32    my @result = <$child_out>;
33
34    close $child_out;
35
36    alarm(0);
37
38    return $result[-1];
39}
40
41package main;
42no strict;
43use Test::More qw(no_plan);
44use SOAP::Lite; # +trace;
45my $soap = SOAP::Lite->new()->proxy('http://');
46no warnings qw(redefine once);
47
48# make override send_receive in CGI client
49*SOAP::Transport::HTTP::Client::send_receive =
50    \&SOAP::Transport::CGI_TEST::Client::send_receive;
51
52my $som = $soap->call('test');
53my $result = $som->result;
54
55
56if ($] >= 5.008) {
57    ok utf8::is_utf8($result), 'return utf8 string';
58    {
59        is $result, 'Überall', 'utf8 content: ' . $result;
60    }
61}
62else {
63    eval { use bytes;
64        is length $result, 8, "length of >$result< is 8 due to wide character";
65
66    }
67}
68