Sign In/My Account | View Cart  
advertisement


Listen Print

Improving mod_perl Sites' Performance: Part 2
by Stas Bekman | Pages: 1, 2

Benchmarking Response Times With crashme Script

Related Reading

Perl & LWP

Perl & LWP
By Sean M. Burke

Table of Contents
Index
Sample Chapter
Read Online--Safari

This is another crashme suite originally written by Michael Schilli (and was located at http://www.linux-magazin.de site, but now the link has gone). I made a few modifications, mostly adding my() operators. I also allowed it to accept more than one url to test, since sometimes you want to test more than one script.

The tool provides the same results as ab above but it also allows you to set the timeout value, so requests will fail if not served within the time out period. You also get values for Latency (seconds per request) and Throughput (requests per second). It can do a complete simulation of your favorite Netscape browser :) and give you a better picture.

I have noticed while running these two benchmarking suites, that ab gave me results from two and a half to three times better. Both suites were run on the same machine, with the same load and the same parameters, but the implementations were different.

Sample output:


  URL(s):          http://www.example.com/perl/access/access.cgi
  Total Requests:  100
  Parallel Agents: 10
  Succeeded:       100 (100.00%)
  Errors:          NONE
  Total Time:      9.39 secs
  Throughput:      10.65 Requests/sec
  Latency:         0.85 secs/Request

And the code:


  #!/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/perl/faq_manager/faq_manager.pl',
            'http://www.example.com/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->{__start_times}->{$entry} = [Time::HiRes::gettimeofday];
  }
  
  ###
  # Are called when connection is closed
  ###
  sub on_return {
    my ($self, $request, $response, $entry) = @_;
    my $start = $self->{__start_times}->{$entry};
    $self->{__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->{__latency_total};
  }
  
  ##################################################
  package main;
  ##################################################
  ###
  # Init parallel user agent
  ###
  my $ua = MyParallelAgent->new();
  $ua->agent("pounder/1.0");
  $ua->max_req($nof_parallel_connections);
  $ua->redirect(0);    # No redirects
  
  ###
  # Register all requests
  ###
  foreach (1..$nof_requests_total) {
    foreach my $url (@urls) {
      my $request = HTTP::Request->new('GET', $url);
      $ua->register($request);
    }
  }
  
  ###
  # Launch processes and check time
  ###
  my $start_time = [gettimeofday];
  my $results = $ua->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->response();
    if($response->is_success()) {
      $succeeded++; # Another satisfied customer
    } else {
      # Error, save the message
      $response->message("TIMEOUT") unless $response->code();
      $errors{$response->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)"          => join("\n\t\t ", @urls),
        "Total Requests"  => "$nof_requests_total",
        "Parallel Agents" => $nof_parallel_connections,
        "Succeeded"       => sprintf("$succeeded (%.2f%%)\n",
                                   $succeeded * 100 / $nof_requests_total),
        "Errors"          => $errors,
        "Total Time"      => sprintf("%.2f secs\n", $total_time),
        "Throughput"      => sprintf("%.2f Requests/sec\n", 
                                   $nof_requests_total / $total_time),
        "Latency"         => sprintf("%.2f secs/Request", 
                                   ($ua->get_latency_total() || 0) / 
                                   $nof_requests_total),
       );
  
  my ($left, $right);
  ###
  # Print out statistics
  ###
  format STDOUT =
  @<<<<<<<<<<<<<<< @*
  "$left:",        $right
  .
  
  while(($left, $right) = splice(@P, 0, 2)) {
    write;
  }

Benchmarking PerlHandlers

The Apache::Timeit module does PerlHandler Benchmarking. With the help of this module you can log the time taken to process the request, just like you'd use the Benchmark module to benchmark a regular Perl script. Of course, you can extend this module to perform more advanced processing like putting the results into a database for a later processing. But all it takes is adding this configuration directive inside httpd.conf:


  PerlFixupHandler Apache::Timeit

Since scripts running under Apache::Registry are running inside the PerlHandler these are benchmarked as well.

An example of the lines which show up in the error_log file:


  timing request for /perl/setupenvoff.pl:
    0 wallclock secs ( 0.04 usr +  0.01 sys =  0.05 CPU)
  timing request for /perl/setupenvoff.pl:
    0 wallclock secs ( 0.03 usr +  0.00 sys =  0.03 CPU)

The Apache::Timeit package is a part of the Apache-Perl-contrib files collection available from CPAN.

References

Return to Perl.com