#!/home/merlyn/bin/perl -Tw $|++; use strict; use CGI ":all"; use HTTP::Daemon; use HTTP::Status; use Chatbot::Eliza; my $HOST = "www.stonehenge.com"; # where are we? my $PORT = 42001; # at what port my $TIMEOUT = 300; # number of seconds until this doc dies my $d = do { local($^W) = 0; new HTTP::Daemon (LocalAddr => $HOST, LocalPort => $PORT) }; my $unique = join ".", time, $$, int(rand 1000); my $url_prefix = "http://$HOST:$PORT"; my $url = "$url_prefix/$unique"; print redirect($url); exit 0 unless defined $d; # do we need to become the server? defined(my $pid = fork) or die "Cannot fork: $!"; exit 0 if $pid; # I am the parent close(STDOUT); my %eliza; # Chatbot::Eliza objects, keyed on session my %when; # most recent activity time, keyed on session { alarm($TIMEOUT); # (re-)set the deadman timer my $c = $d->accept; # $c is a connection my $r = $c->get_request; # $r is a request (my $session = $r->url->epath) =~ s{^/}{}; unless ($session =~ /^\d+\.\d+\.\d+$/) { $c->send_error(RC_FORBIDDEN, "I don't think we've made an appointment!"); close $c; redo; } $c->send_basic_header; $CGI::Q = new CGI $r->content; my $eliza_says = "How do you do? Please tell me your problem."; my $message = param("message") || ""; if ($message) { param("message",""); $eliza{$session} ||= new Chatbot::Eliza; $eliza_says = $eliza{$session}->transform($message); $when{$session} = time; } print $c header, start_html("The doctor is in!"), h1("The doctor is in!"), p("This script is from a future", a({-HREF => "http://www.stonehenge.com/merlyn/WebTechniques/"}, cite("Web Techniques")," Perl column.")), hr, startform("POST", "$url_prefix/$session"), $eliza_says && p($eliza_says), p, textfield(-name => "message", -size => 60), p, submit("What do you say, doc?"), p("Note: the doctor is patient, but waits only $TIMEOUT seconds, so hurry!"), endform, hr, end_html; close $c; for (keys %when) { next if $when{$_} > time - $TIMEOUT; delete $eliza{$_}; delete $when{$_}; } redo; }