use HTTP::Daemon; use IPC::Open2; $|=1; my $server=HTTP::Daemon->new(LocalPort=>80,LocalAddr=>'localhost'); print "Please contact me at <URL:", $server->url, ">\n"; while($client=$server->accept){ while(my $answer=$client->get_request){ $ans=$answer->as_string; @ans=split /\n/,$ans; $client->autoflush; if($answer->method eq 'GET'){ $path=$answer->url->path; (error,last) unless $path=~s#^/##; if($path=~/html$/i){ $client->send_file_response($path); last; } if($path=~/cgi$/i){ $ENV{REQUEST_METHOD}=$answer->method; $query=$answer->url->query; $ENV{CONTENT_LENGTH}=length($query); $ENV{QUERY_STRING}=$query; $out=`perl $path`; $out=~s/.*?\n\n//s; #remove HTTP header print $client $out; last; } } if($answer->method eq 'POST'){ $path=$answer->url->path; (error,last) unless $path=~s#^/##; if($path=~/cgi$/i){ $query=$answer->url->query; $ENV{REQUEST_METHOD}=$answer->method; for(@ans){ $ENV{CONTENT_LENGTH}=$1 if /Content-Length: (\d+)/; $ENV{HTTP_REFERRER}=$1 if /Referer: (.*)/; } $query=$ans[-1]; undef $CGI;undef $OUT; $pid=open2($CGI,$OUT,"perl","$path") or error; print $OUT $query; close $OUT; @out=<$CGI>; waitpid $pid,0; $out=join "\n",@out; $out=~s/.*?\n\n//s; #remove HTTP header print $client $out; last; } } last; } print "CLOSE: ", $client->reason, "\n" if $client->reason; undef $client; } sub error{ $client->error(RC_FORBIDDEN); print "An error occurred in $ans\n"; }
In reply to Re: Testing ActivePerl scripts locally
by chas
in thread Testing ActivePerl scripts locally
by tomgracey
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |