in reply to Re: Re: Re: multithreaded web application server in perl
in thread multithreaded web application server in perl
Here is the main program I'm working with right now... It's incomplete but shows the backbone minus the irrelevant business content...
use strict; use HTTP::Daemon; use HTTP::Response; use HTTP::Status; use BusinessLogic; use threads; my %opt = (); getopt('sx', \%opt); # -i, input file name [-t template name], valu +es in %opts. unless (defined $opt{s} ) { print STDOUT "\nUsage: ./orgserver -s datasourcename [-x xmloutput +flatfile]\n\n"; exit 0; } unless (-r $opt{s}) {print "Unable to read $opt{s}"} if ($opt{x}) {unless (-w $opt{x}) {print "Unable to write to $opt{w}"} +;exit 0} $| = 1; my $xmlfile = "OrgTree.xml"; my $xmlflatfile = $opt{'x'} || "FlatOrgFile.xml"; my $sourcefile = $opt{'s'} || 'data/infile-big.txt'; my $E = BusinessLogic->new({ sourcefile=>$sourcefile, xmlfile=>$xmlfile, xmlflatfile=>$xmlflatfile }); $E->writeLog(99,"new Model tree and Daemon created"); #create the HTTP::Daemon instance my $d = new HTTP::Daemon LocalAddr => $E->{server}->{hostname}, LocalPort=>$E->{server}->{url}; $| = 1; #should be familiar... many parts based on webserver in 100 lines by C +orion http://www.perlmonks.org/index.pl?node_id=116767 (from what I r +emember) print "Please contact me at: <URL: ", $d->url, " >\n"; for (;;) { $DB::single = 2; my $connect = $d->accept; print "We got a request '$connect'!\n"; my $thread = threads->new(\&connection,$connect,$E); $thread->detach; print "have detached from this connection\n"; } sub connection { my $c = shift; my $E = shift; print "We are starting a new connection thread with connection '$c'\n"; print "listening for request\n"; while (my $r = $c->get_request) { print "We got a request\n"; #ignore all but GET requests if ($r->method eq 'GET') { $E->{method} = $r->method; $E->regen(); $E->writeLog(99,"\n\n\n--------n\n\n"); $E->writeLog(8,"Incoming GET Request Content",$E->{request +}); my $path = $r->url->path; print "We are handling path request $path\n"; my $command = $E->securePath($path); #handle the command passed to us in the GET an +d generates the output headers and body my $ref = $E->run( +) || $E->writeLog(99,"Error processing $command! +",$!); $E->writeLog(8,'business logic finished'); my $response = new HTTP::Response( 404,undef,undef,"404 - +Not found." ); foreach my $key ( keys %{$E->{response}->{header}} ) { $response->header( $key=>$E->{response}->{header}->{$ke +y} ) } $response->content($E->{response}->{content}); $response->code($E->{response}->{code}); $c->send_response($response); } else { # go away! $c->send_error(RC_FORBIDDEN); } $E->regen(); } print "Closing connection '$c'"; $c->close; undef($c); }
hackmare
roasp.com
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Re: Re: Re: Re: multithreaded web application server in perl
by perrin (Chancellor) on Dec 10, 2002 at 17:57 UTC |