#! perl -sw
use strict;
use threads;
use threads::shared;
## The main code stores the status information here
## Die is a flag used to ensure the thread shuts down properly.
## It could be made a separate variable if it is inconvenient.
my %status : shared = map{ $_ => 0 } qw[ This That TheOther Die ];
sub statusThread {
require HTTP::Daemon;
require HTTP::Response;
my $d = HTTP::Daemon->new( LocalAddr => 'localhost', LocalPort => 80 )
or die $!;
my $resp = new HTTP::Response;
while( my $c = $d->accept ) {
warn "Accepted\n";
while( my $r = $c->get_request ) {
warn "Requested\n";
unless( $r->method eq 'GET'
and $r->url->path eq "/status.htm"
) {
$c->send_error( 403 );
$c->force_last_request;
warn "Denied\n";
next;
}
my $statusPage = 'Status'
. join( "\n", map {
"$_ : $status{ $_ }
"
} grep{ !/Die/ } keys %status )
. '';
$resp->code( 200 );
$resp->headers( Expires => scalar localtime );
$resp->content( $statusPage );
$c->send_response( $resp );
$c->force_last_request;
warn "Responded\n";
}
$c->close;
warn "Closed\n";
undef($c);
return if $status{ Die };
}
}
## Create the web server in a thread
my $daemon = threads->create( \&statusThread );
## The rest of your program goes here
my $life = 10000;
while( --$life ) {
$status{ (qw[ This That TheOther ])[ rand 3 ] }++;
select undef, undef, undef, rand;
}
$status{ Die }++;
$daemon->join