#!/usr/bin/perl -w
  
  use LWP::Parallel::UserAgent;
  use Time::HiRes qw(gettimeofday tv_interval);
  use strict;
  use HTTP::Cookies;
  use CGI;

###### debug LWP
#use LWP::Debug qw(+);

######################################################################
+########  
###
# Configuration
###
  my $nof_parallel_connections = 1; 
# reqs per session
  my $nof_requests_total = 1; 
## timeout (seconds)
  my $timeout = 10;
## array of urls to call
  my @urls = (
            'http://212.31.252.200/test/benchmark/1.asp',
            'http://212.31.252.200/test/benchmark/2.asp',
           );
          
## params to POST to the preceeding URLs
# encoded 
# I know this ain't nice but will fix it later
my $param1="text1=".&URL_Encode("5 dd");
  my @params = (
    '',
    $param1,
    );

##  use Cookies
my $COOKIES=1;  

# use basic auth
my $AUTH=0;
my $idauth="golem";
my $pwdauth="washere";

#debug : print pages received
my $OUTPUTDEBUG=1;
# debug : save errors in out.txt
my $ERRDEBUG=0;
# debug : print http requests
my $REQUEST=0;

# cookies variables
my $SEENCOOKIE=0;
my $cookies = HTTP::Cookies->new;
my $savedcookies="";  
  
######################################################################
+############
  
  
  ##################################################
  # Derived Class for latency timing
  ##################################################
  
  package MyParallelAgent;
  @MyParallelAgent::ISA = qw(LWP::Parallel::UserAgent);
  use strict;
  
  ###
  # This Is called when connection is opened
  ###
  sub on_connect {
    my ($self, $request, $response, $entry) = @_;
    
      # cookies ########
  if ($SEENCOOKIE) {
  print "***********I have seen cookies and I'm using them*********\n"
+;
    # tried all these:
    #print $savedcookies;
    $cookies->revert;
    #$cookies>set_cookie($savedcookies);
    #$cookies->load();
        }
       
    $self->{__start_times}->{$entry} = [Time::HiRes::gettimeofday];
  }


  
  ###
  # This is 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);


  # cookies seen for first time
if (!($SEENCOOKIE))
{
  $cookies->extract_cookies($response);
  $savedcookies=$cookies->as_string();
  print "I received this cookie string:\n";
  print $savedcookies;
  $SEENCOOKIE=1;
}

    if ($OUTPUTDEBUG) {
    print "\n pagina ".$request->url;    
    print "\n****** :\n".$response->content;
    }

    ## debug : print errors
    #

if ($ERRDEBUG)    {
    if (!($response->is_success)) {
    open OUT, ">>out.txt" or die "Cannot open out.txt for write :$!";
    print OUT "\n*************** error on: ".$request->url;
    print OUT "\n*************** error type: ".$response->error_as_HTM
+L;
    print OUT "\n*************** error page from server: ".$response->
+content;
    close OUT;
    }


    

}
    #######################à
    
  }
  
  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("Mozilla/4.76 [en] (Windows NT 5.0; U)");
  $ua->max_req($nof_parallel_connections);
  $ua->redirect(1);    # follow redirects
  #$ua->in_order  (1);  # segui nell'ordine di registrazione
  
  ###
  # Register all requests
  ###
  foreach (1..$nof_requests_total) {

# POST params counter
my $ct=0;
    
    foreach my $url (@urls) {
    
    my $request = HTTP::Request->new('POST', $url);
       $request->content_type('application/x-www-form-urlencoded');
       $request->content($params[$ct]);
       
      # basic auth
      if ($AUTH) {
      $request->authorization_basic($idauth, $pwdauth);
      }

### debug : print http request
 if ($REQUEST) { 
 print $request->as_string();
 }
            
      $ct++;
      $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", @urls),
        "Total Requests"  => "$nof_requests_total",
        "Parallel Agents" => $nof_parallel_connections,
        "Succeeded"       => sprintf("$succeeded (%.2f%%)\n",
                                   $succeeded * 100 / $nof_requests_to
+tal),
        "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
  ###

print "\n#################### results #################\n";
foreach (@P) {
    print "$_ \n";
}

exit;

# Usage  : $URL_encoded = &URL_Encode("$plaintext");
sub URL_Encode {
  my($text)  = $_[0];     # text to URL encode
  $text=CGI::escape($text);
  return $text;      # return URL encoded text
  }
[download]

Edit Masem 2001-09-17 - Code Tags and other formatting