#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use FCGI;
use File::Temp ();
use FCGI::Client::Connection;
use Getopt::Std;
use IO::Socket;
use POSIX ();
use Time::HiRes 'sleep';
my %opts;
getopts('u', \%opts);
my %env;
my $socketfile = File::Temp::tmpnam;
# $t gets a string perl's internal representation
my $t = "Bäh\n";
print qq{\n*** Call me with option "-u" to show FCGI's brokeness ***\n\n}
unless $opts{u};
print "original un-encoded content (might look broken on unicode terminal):\n";
print $t, "\n";
print "content ", (utf8::is_utf8($t) ? 'is' : 'is not'), " utf8\n";
print "\n";
print "content is encoded into a utf-8 octet stream\n";
# encode into utf-8 encoded octet stream
utf8::encode($t);
print "done\n";
print "content ", (utf8::is_utf8($t) ? 'is' : 'is not'), " utf8\n";
print "\n";
if ($opts{u}) {
print "content's utf-8 flag is set again\n";
# set utf-8 flag (again)
utf8::upgrade($t);
print "done\n";
print "\$t ", (utf8::is_utf8($t) ? 'is' : 'is not'), " utf8\n";
print "\n";
}
print "Content to be queried through FCGI:\n";
print $t, "\n";
my $pid = fork();
if ($pid) { # parent
my $con = FCGI::Client::Connection->new(sock => create_socket());
my ($stdout, $stderr) = $con->request(
{REQUEST_METHOD => 'GET', QUERY_STRING => ''}, ''
);
print "Content received through FCGI:\n";
print $stdout;
kill TERM => $pid;
wait;
}
elsif (defined $pid) { # child
print "FastCGI daemon started (pid $$)\n";
open STDIN, "+</dev/null" or die $!;
open STDOUT, ">&STDIN" or die $!;
open STDERR, ">&STDIN" or die $!;
POSIX::setsid();
my $sock = FCGI::OpenSocket($socketfile, 100 )
or die "failed to open FastCGI socket; $!";
my $request = FCGI::Request(
\*STDIN, \*STDOUT, \*STDERR, \%env, $sock
);
while($request->Accept() >= 0) {
print $t;
}
}
else {
die "cannot fork\n";
}
sub create_socket {
my $retry = 20;
while ($retry-- >= 0) {
my $sock = IO::Socket::UNIX->new(Peer => $socketfile);
return $sock if $sock;
sleep 0.3;
}
die "cannot open socket $socketfile: $!";
}
RT for rt.cpan.org