benchmarking code

John D Groenveld (jdg117@elvis.arl.psu.edu)
Wed, 19 Aug 1998 13:25:27 -0400 

Here's some code to benchmark various authentication backends.
John
groenveld@acm.org

#!/usr/bin/perl -w
# based on code posted to LWP mailling list by Bowen Dwelle

use strict;
use Benchmark;
use Getopt::Long;
use LWP::UserAgent;

$|=1;
my $children = 5;
my $iterations = 5;
GetOptions(
	'children=i' => \$children,
	'iterations=i' => \$iterations,
	);
my @userids;
while ( <> ) {
    chomp;
    push @userids, $_;
}

timethese($iterations,
	{
	'DBM Authentication' => sub {
		foreach (@userids) {
			forking_lwp($children,
				"$_:password",
				"http://somehost/PERL98/DBM/");
		}
	},
	'ORACLE Authentication' => sub {
		foreach (@userids) {
			forking_lwp($children,
				"$_:password",
				"http://somehost/PERL98/ORACLE/");
		}
	},
	'Oracle Login Authentication' => sub {
		foreach (@userids) {
			forking_lwp($children,
				"$_:password",
				"http://somehost/PERL98/OracleLogin/");
		}
	},
	'TEXT Authentication' => sub {
		foreach (@userids) {
			forking_lwp($children,
				"$_:password",
				"http://somehost/PERL98/TEXT/");
		}
	},
	}
	);

sub forking_lwp {
    my($children, $credentials, $url) = @_;
    my($userid, $password) = split /:/, $credentials;
    my $pid;
    foreach (1..$children) {
        unless ( $pid = fork() ) {
            my $ua = new LWP::UserAgent;
            my $req = new HTTP::Request GET => $url;
            $req->authorization_basic($userid, $password);
            my $res = $ua->request($req);
            warn "LWP request with URL:$url failed"
		if ( $res->is_error() );
            exit;
        }
        if (! defined $pid) {
            die "fork problem $!\n";
        }
    }

    foreach (1..$children) {
       wait;
    }
}