<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w

use LWP::Parallel::UserAgent;
use Time::HiRes qw(gettimeofday tv_interval);
use strict;

###
# Configuration
###

my $nof_parallel_connections = 10;
my $nof_requests_total = 100;
my $timeout = 10;
my @urls = (
	    'http://www.example.com:81/perl/faq_manager/faq_manager.pl',
	    'http://www.example.com:81/perl/access/access.cgi',
	   );


##################################################
# Derived Class for latency timing
##################################################

package MyParallelAgent;
@MyParallelAgent::ISA = qw(LWP::Parallel::UserAgent);
use strict;

###
# Is called when connection is opened
###
sub on_connect {
  my ($self, $request, $response, $entry) = @_;
  $self-&gt;{__start_times}-&gt;{$entry} = [Time::HiRes::gettimeofday];
}

###
# Are called when connection is closed
###
sub on_return {
  my ($self, $request, $response, $entry) = @_;
  my $start = $self-&gt;{__start_times}-&gt;{$entry};
  $self-&gt;{__latency_total} += Time::HiRes::tv_interval($start);
}

sub on_failure {
  on_return(@_);  # Same procedure
}

###
# Access function for new instance var
###
sub get_latency_total {
  return shift-&gt;{__latency_total};
}

##################################################
package main;
##################################################
###
# Init parallel user agent
###
my $ua = MyParallelAgent-&gt;new();
$ua-&gt;agent("pounder/1.0");
$ua-&gt;max_req($nof_parallel_connections);
$ua-&gt;redirect(0);    # No redirects

###
# Register all requests
###
foreach (1..$nof_requests_total) {
  foreach my $url (@urls) {
    my $request = HTTP::Request-&gt;new('GET', $url);
    $ua-&gt;register($request);
  }
}

###
# Launch processes and check time
###
my $start_time = [gettimeofday];
my $results = $ua-&gt;wait($timeout);
my $total_time = tv_interval($start_time);

###
# Requests all done, check results
###

my $succeeded     = 0;
my %errors = ();

foreach my $entry (values %$results) {
  my $response = $entry-&gt;response();
  if($response-&gt;is_success()) {
    $succeeded++; # Another satisfied customer
  } else {
    # Error, save the message
    $response-&gt;message("TIMEOUT") unless $response-&gt;code();
    $errors{$response-&gt;message}++;
  }
}

###
# Format errors if any from %errors
###
my $errors = join(',', map "$_ ($errors{$_})", keys %errors);
$errors = "NONE" unless $errors;

###
# Format results
###

#@urls = map {($_,".")} @urls;
my @P = (
      "URL(s)"          =&gt; join("\n\t\t ", @urls),
      "Total Requests"  =&gt; $nof_requests_total * @urls,
      "Parallel Agents" =&gt; $nof_parallel_connections,
      "Succeeded"       =&gt; sprintf("$succeeded (%.2f%%)\n",
				   $succeeded * 100 / ( $nof_requests_total * @urls ) ),
      "Errors"          =&gt; $errors,
      "Total Time"      =&gt; sprintf("%.2f secs\n", $total_time),
      "Throughput"      =&gt; sprintf("%.2f Requests/sec\n",
				   ( $nof_requests_total * @urls ) / $total_time),
      "Latency"         =&gt; sprintf("%.2f secs/Request",
				   ($ua-&gt;get_latency_total() || 0) /
				   ( $nof_requests_total * @urls ) ),
     );

my ($left, $right);
###
# Print out statistics
###
format STDOUT =
@&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt; @*
"$left:",        $right
.

while(($left, $right) = splice(@P, 0, 2)) {
  write;
}
</pre></body></html>