Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

CGI::Application + Net::HTTPServer

by gryphon (Abbot)
on Jun 06, 2005 at 04:36 UTC ( #463825=CUFP: print w/ replies, xml ) Need Help??

Greetings fellow monks,

A while back, I posted about trying to wrap an existing CGI::Application web app inside a Net::HTTPServer script without making any modifications to the CGI::Application app's code. After some hacking, I think I've come up with something that mostly works. I've tested it for GET, POST, cookies, and redirects. It seems to do OK. There's one known bug: It doesn't save multiple cookies in a single request due to (what I think is) a bug in how Net::HTTPServer handles headers. So you can only save one cookie at a time for now.

#!/usr/bin/perl use strict; use warnings FATAL => 'all'; use Net::HTTPServer; my $httpd = Net::HTTPServer->new( 'port' => 8081, 'docroot' => 'htdocs', 'index' => ['index.html', 'index.pl', 'index.cgi'], 'log' => 'STDOUT', 'type' => 'forking', 'type' => 'single', 'numproc' => 5 ); use CGI qw(-compile -oldstyle_urls); use YourCGIApplicationModule; sub yourapp { my $req = shift; my $res = $req->Response; $ENV{$_} = $req->Env($_) || '' foreach (keys(%{$req->Env()})); $ENV{HTTP_COOKIE} = join ('; ', map { $_ . '=' . $req->Cookie($_) +} keys %{$req->Cookie()}); my $your_cgi_app = YourCGIApplicationModule->new({ QUERY => CGI->new( ($req->Method eq 'GET') ? $req->Query : ($req->Request =~ /\n\W*\n([^\n]+)/) ? $ +1 : '' ) }); $res->CaptureSTDOUT; $your_cgi_app->run; $res->ProcessSTDOUT({ strip_header => 0 }); my ($headers, @content) = split(/\n\n/, $res->Body); my $code = 200; foreach (split(/\n/, $headers)) { if (/^(.*?): (.*)$/) { $res->Header($1, $2); $code = $1 if (($1 eq 'Status') and ($2 =~ /^(\d+)\s/)); } } $res->Code($code); $res->Body( join("\n\n", @content) ); return $res; } $httpd->RegisterURL({ '/yourapp' => \&yourapp }); $httpd->Start; $httpd->Process; $httpd->Stop; exit 0;

As always, I'm interested in any rewrites or suggestions you folks have. Thanks.

gryphon
Whitepages.com
code('Perl') || die;

Janitored by holli - added readmore tags

Comment on CGI::Application + Net::HTTPServer
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://463825]
Approved by Zaxo
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (15)
As of 2015-07-06 20:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (83 votes), past polls