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);
}
[download]

hackmare
roasp.com

It is very cool that Perl threads have come far enough for this to work now. It will soon be possible to do this without the need to write your own web server code by using mod_perl 2 with Apache 2 in multi-threaded mode. In fact you can do it right now, but there are CPAN modules (mostly ones that use XS) which will have problems with a threaded environment at this point.