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