##### listing one ##### #!/home/merlyn/bin/perl -w use strict; $|++; use FindBin qw($Bin); use lib $Bin; use StressAgent; use HTTP::Request::Common; ## use LWP::Debug qw(+); # DEBUG my @YOW = do { local (@ARGV, $/) = "/usr/local/share/emacs/20.2/etc/yow.lines"; split /\0\s*/, <>; }; shift @YOW; # first one is a comment my %ASKED = (); StressAgent->new(\&patient)->do_it(5); sub patient { my ($request,$response,$entry) = @_; return GET "http://www.stonehenge.com/cgi/eliza2" unless $request; if ($response->code == 200) { ## print $response->as_string; return; ## debug my @content = $response->content =~ /(.*)\n?/g; my ($url) = $content[2] =~ /action="(.*?)"/i; my ($prompt) = $content[3] =~ /

(.*?)<\/p>/i; for ($ASKED{$url} || "[initial question]", " -> ", $prompt) { print map " $_\n", split /\n/; } my $yow = $YOW[rand @YOW]; $ASKED{$url} = $yow; return POST $url, [message => $yow]; } print $response->as_string; return; } ##### listing two ##### use strict; package StressAgent; use LWP::Parallel::UserAgent; use vars qw(@ISA); @ISA = qw(LWP::Parallel::UserAgent); sub new { my $package = shift; my $self = $package->SUPER::new(); my $make_request = shift; $self->{+__PACKAGE__}{make_request} = $make_request; $self->{+__PACKAGE__}{did} = 0; $self->agent(+__PACKAGE__ . " (".$self->agent.")"); $self->env_proxy; $self->max_req(1000); # never reached $self; } sub maybe_register { my $self = shift; my $new_request = $self->{+__PACKAGE__}{make_request}->(@_); $self->register($new_request) if defined $new_request; } sub on_return { my $self = shift; my ($request, $response, $entry) = @_; print localtime().": ", $response->code, ", ", $response->message, " {",++$self->{+__PACKAGE__}{did}, "}\n"; $self->maybe_register(@_); $self->discard_entry($entry); $self; } sub do_it { my $self = shift; my $max = shift || 10; my $wait = shift || 15; for (1..$max) { $self->maybe_register(); } $self->wait($wait); } 1;