Combining HTTP:Daemon and CGI

Hi all,

I am working on a script for a simple Browser based GUI.

The idea is to create an HTTP:daemon object on a random local port, spawn a
browser on the local machine pointing to the daemon's URL , send a form to
the browser via CGI and process the user response.

The code works fine up to processing of the form (a POST request). I can see
the form in the browser, and see the request coming back, once the SUBMIT
button is pressed.

I ran into a problem trying to make CGI to process the request within the
daemon process.
My understanding is that CGI relies on the Web Server to set up a bunch of
environment variables, invoke the CGI script and feed the POST request to
the script via STDIN.

In order to imitate this setup I populated the environment variables from
the HTTP::Request object, wrote the content field (supposetely containing
the POST data) into a file, redirected STDIN from the file and started CGI
(see below). However, the CGI module does not parse the content correctly.

Has anyone tried to make CGI work in t a similar environment?

--------------------------------------------------------


Here is the code:

use strict;

use CGI ':all';
use HTTP::Daemon;
use Win32::Process;
use Win32;
use File::Temp qw/tempfile/;
use File::Slurp;

my %template = ('title' => Title',
'fields' => [
{
'name' => 'LABEL',
'type' => '=s',
'default' => 'V100_005',
},
{
'name' => 'PLATFORM',
'type' => '=c',
'default' => ['one', 'two'],
},
{
'name' => 'PRODUCT',
'type' => '=c',
'default' => ['one', 'two'],
},
{
'name' => 'Whatever',
'type' => '=s',
'default' => 'however',
},
],
);

my %cgi_env = (
'CONTENT'=> sub {$_[0]->content},
'CONTENT_LENGTH' => \&content_length,
'CONTENT_TYPE' => sub {$_[0]->headers->{'content-type'}
if exists $_[0]->headers->{'content-type'}},
'QUERY_STRING' => sub {$_[0]->uri =~ /\?(.+$)/; $1},
'REQUEST_METHOD' => sub {$_[0]->method},
'REQUEST_URI' => sub {$_[0]->uri;},
);

$| = 1;
my $d = HTTP::Daemon->new || die;

# Spawn the browser with out URL
my $proc;
unless (Win32::Process::Create($proc,'c:\\WINDOWS\\system32\\cmd.ex e',
sprintf('cmd /C start %s', $d->url )
,0,NORMAL_PRIORITY_CLASS,'.'))
{
die Win32::FormatMessage( Win32::GetLastError() );
}

my ($fh, $tmpfile) = tempfile("cgiXXXXXX", UNLINK => 1, DIR =>
File::Spec->tmpdir());
close $fh;

while (my $c = $d->accept) {

my $r = $c->get_request;
if ($r->method eq 'GET') {
# Push table out
generate_form($c, \%template);
} elsif ($r->method eq 'POST') {
# Cheat CGI to a temp file
write_file($tmpfile, $r->content);

local *STDIN;
unless (open STDIN, '<', $tmpfile)
{
die "cannot redirect stdIN:$!";
}

CGI::initialize_globals();
set_env($r);
my $cgi = new CGI;
# can't make it to read content
1;

} {
# Process response
1;
last;
}

close $c;
}

sub set_env
{
my $r = shift;
while (my ($k, $v) = each %cgi_env) {
$ENV{$k} = $v->($r);
}

# Also set the HTTP_ from headers
while (my ($k, $v) = each %{$r->headers}) {
my $n = $k;
$n =~ s/-/_/g;
$n = 'HTTP_' . uc $n;
$ENV{$n} = $v;
}
}

sub content_length
{
my $r = shift;
my $b = $r->headers->{'content-type'};
$b =~ s!^multipart/form-data; boundary=!!;
my $bl = length $b;
my @num = $r->content =~ /$b/g;
length($r->content) - $#num * $bl;
}

sub content
{
my $r = shift;
$r->content;
}

sub content_type {
my $r = shift;
$r->headers->{'content-type'} if exists $r->headers->{'content-type'};
}

sub query_string {
my $r = shift;
$r->uri =~ /\?(.+$)/;
$1;
}
sub request_method {
my $r = shift;
$r->method;
}
sub request_uri {
my $r = shift;
$r->uri;
}

sub generate_form
{
my ($c, $desc) = @_;

# This will make our life easier
local *STDOUT;
unless (open STDOUT, '>&', $c)
{
die "cannot redirect stdout:$!";
}

# Create table data
my @tds;
foreach (@{$desc->{'fields'}}) {
my $type = substr($_->{'type'}, 1, 1);
my $td;
if ($type eq 's') { # String
$td = textfield('-name' => $_->{'name'},
'-size' => 50,
'maxlength' => 256,
'-value' => $_->{'default'},
);
} elsif ($type eq 'm') { # Menu
$td = popup_menu(-name=> $_->{'name'},
-values => $_->{'default'});
} elsif ($type eq 'c') { # Checkbox
$td = checkbox_group('-name' => $_->{'name'}, '-values' =>
$_->{'default'});
}
else {
die sprintf('Invalid type %s for element %s', $type, $_->{'name'});
}
push(@tds, td([$_->{'name'} . ': ', $td]));
}

print start_html($desc->{'title'}), h1(sprintf('Enviroment for Project
%s', $desc->{'title'}));
print start_form('-align' => 'center');
print table({-border=>2},
Tr({-align=>'LEFT', -valign=>'TOP'},
[
th(['Name', 'Value']),
@tds,
]
)
);

print submit(-name=> 'Submit');
print endform;

print end_html;
close STDOUT;
}