If HTTP::Daemon worked this would be easy with a thread.
I take it back. My browser was being overzealous in it's caching.
Run this and the type http://localhost/status.htm in your browser. Refresh to see the status change.
Code updated: Corrected a couple of stupidities on my behalf and added an expires header to avoid the browser caching problem.
#! 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 = '<HTML><HEAD><TITLE>Status</TITLE></HEAD>
+<BODY>'
. join( "\n", map {
"<p>$_ : $status{ $_ }</p>"
} grep{ !/Die/ } keys %status )
. '</BODY></HTML>';
$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
Examine what is said, not who speaks.
Silence betokens consent.
Love the truth but pardon error.
|