[Pdx-pm] Q about ithreads && signals

[Joshua Hoblitt]

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);
        }
}