fcgi_unicode_test.pl

#!/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: $!";
}