sub serve_everything
{
    my ($conn, $req) = @_;
    ...
    $ENV{CONTENT_TYPE}   = join('; ', $req->content_type) || '';
    ...
    local *main::STDIN = $conn;
    use CGI;
    my $cgi = CGI->new();
[download]

This snippet of code:

my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;
[download]

Is common to both CGI and CGI::Simple. Do you have a complete test case that generates the hang? That would make it easier to debug.....

cheers

tachyon

Just fire this up and point your browser to localhost. Then submit one of the last two forms and watch the hang

#!/usr/bin/perl -w

use strict;

use Cwd qw( cwd );

use File::Spec;
$ENV{DOCUMENT_ROOT} = cwd();
chdir $ENV{DOCUMENT_ROOT};

use Data::Dumper;
use HTTP::Daemon;
use HTTP::Status;
use CGI::Simple();
use CGI();

my $port    = shift || 80;
my $docroot = shift || $ENV{DOCUMENT_ROOT};

my $d = HTTP::Daemon->new(
    Reuse     => 1,
    LocalPort => $port,
) or die "No daemon: $!\n";

warn "Ready to go!\n";
while (my $conn = $d->accept())
{
    handle_uri( $conn, $conn->get_request( 1 ));
}

sub handle_uri
{
    my ($conn, $req) = @_;
    my $uri  = $req->uri();
    
    if ($uri =~ /images/)
    {
        serve_image( $conn, $req, $uri );
    }
    else
    {
        serve_everything( $conn, $req, $uri );
    }
}

sub serve_everything
{
    my ($conn, $req) = @_;
    my $uri = $req->uri;

    $ENV{REQUEST_METHOD} = $req->method;
    $ENV{CONTENT_TYPE}   = join('; ', $req->content_type ) || '';
    $ENV{CONTENT_LENGTH} = $req->content_length || '';
    $ENV{HTTP_USER_AGENT} = join('; ', $req->user_agent ) || '';
    $ENV{SCRIPT_NAME}    = $uri->path  || 1;
    $ENV{QUERY_STRING}   = $uri->query || '';
    $ENV{HTTP_HOST} = $req->header('host');
    $ENV{REMOTE_ADDR} = $conn->peerhost();
    $ENV{REMOTE_PORT} = $conn->peerport();

    foreach my $c (qw( cookie cookies ))
    {
        $ENV{uc $c} = join(';', $req->header( $c ) ) || '';
    }

    my $cgi;
    {
#        warn '$ENV{CONTENT_LENGTH} = ',$ENV{CONTENT_LENGTH},$/;
#        local $_;
#        warn "read ", sysread($conn, $_, $ENV{CONTENT_LENGTH}, 0);
#        warn $_,$/,$/;
        local *main::STDIN = $conn;
        $cgi = CGI::Simple->new();
#        $cgi = CGI->new(); # CGI works, CGI::Simple hangs :(
    }

    $conn->send_response(
        HTTP::Response->new(
            200, 'OK',
            HTTP::Headers->new(
            Set_Cookie => $cgi->cookie(
                        -name =>'sessionID',
                        -value =>'xyzzy',
                        -expires =>'+1y',
                        -path =>'',
                        -domain => $ENV{HTTP_HOST},
                        -secure => 0
                    ),
            Content_Type => "text/html"),
            "<font size=2><pre>".
                CGI::Simple->escapeHTML(
                    scalar Dumper(
                        $conn, $req, \%ENV, $cgi
                    )
                ).
qq|
</font></pre>
<hr>
<FORM
  METHOD="GET"
  ACTION="$ENV{SCRIPT_NAME}"
  ENCTYPE="application/x-www-form-urlencoded">
    <input type="text" name"f">
    <input type="reset" name=".reset" />
    <input type="submit" name=".submit" />
</form>
<FORM
  METHOD="POST"
  ACTION="$ENV{SCRIPT_NAME}"
  ENCTYPE="application/x-www-form-urlencoded">
    <input type="text" name"f">
    <input type="reset" name=".reset" />
    <input type="submit" name=".submit" />
</form>
<FORM
  METHOD="POST"
  ACTION="$ENV{SCRIPT_NAME}"
  ENCTYPE="multipart/form-data">
    <INPUT TYPE="file" NAME="upload_file1" SIZE="42">
    <INPUT TYPE="file" NAME="upload_file2" SIZE="42">
    <input type="reset" name=".reset" />
    <input type="submit">
</FORM>
|
        )
    );

    $conn->print( 'nope', $@ ) if $@;
}

sub serve_image
{
    my ($conn, $req, $uri) = @_;
    my $file = File::Spec->catfile( $docroot, $uri );
    $conn->send_status_line( (-e $file ? 200 : 404 ) );
    $conn->send_file_response( $file );
}
[download]

MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"

I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).

** The third rule of perl club is a statement of fact: pod is sexy.