[Pdx-pm] Q about ithreads && signals
Joshua Hoblitt
jhoblitt at ifa.hawaii.edu
Sat Nov 16 21:13:49 CST 2002
I've written a few Perl programs with ithreads and so far had pretty good success. This time I'm lost as to exactly what is going wrong ( something with signals ).
The goal here is to have a simple proxy that requests the same document every 10 seconds (thats how often it is updated) and then serves it up it up to multiple clients internally. This is a simple prototype of cut 'n paste examples (multi-client support/etc isn't added yet) so it's pretty ugly ( please excuse ).
Sorry for using the list as a help desk.
Cheers,
-J
--
use strict;
use warnings;
use threads qw( yield );
use threads::shared;
use LWP::UserAgent;
# target webserver speaks broken http/1.1, use http/1.0 instead
use LWP::Protocol::http10;
LWP::Protocol::implementor('http', 'LWP::Protocol::http10');
BEGIN {
# just using require seems so boring
use Config;
die "You need a perl build that supports ithreads\n" unless $Config{useithreads};
}
our $doc : shared = 1;
threads->new( \&proxy_thread );
&listen_thread;
sub proxy_thread {
print "entered proxy\n";
use Time::HiRes qw( ualarm sleep );
&get_doc;
eval {
local $SIG{ALRM} = sub { &get_doc };
ualarm 10_000_000, 10_000_000;
while(1) { sleep; }
};
sub get_doc {
my $ua = new LWP::UserAgent;
$ua->agent("IFA_Weather_Data_Collector/0.1");
my $req = HTTP::Request->new( GET => "http://www.google.com" );
# don't follow redirects
my $res = $ua->simple_request( $req );
# Check the outcome of the response
if ($res->is_success && $res->content_type eq 'text/html') {
lock( $doc );
$doc = $res->content;
print "work happened\n";
} else {
lock( $doc );
$doc = "shit happened\n";
print $doc;
}
}
}
sub listen_thread {
print "entered listen\n";
use HTTP::Daemon;
use HTTP::Status;
my $d = HTTP::Daemon->new(
# LocalPort => 8080,
LocalAddr => '127.0.0.1',
) || die;
print "Please contact me at: <URL:", $d->url, ">\n";
while (my $c = $d->accept) {
while (my $r = $c->get_request) {
if ($r->method eq 'GET' and $r->url->path eq "/") {
lock( $doc );
$c->send_response(
HTTP::Response->new( 200, 'ok', $doc )
);
} else {
$c->send_error(RC_FORBIDDEN)
}
}
$c->close;
undef($c);
}
}
More information about the Pdx-pm-list
mailing list