The reason I recently ended up diving down the rabbit hole of the
same_interp_tie method was actually that I was working on writing a
helper method to watch memory size on a mod_perl process. My
methodology was simply a brute force series of requests with a memory
check before and after.
I'd be interested in any feedback on what I've got so far. I was also
thinking it might fit nicely in Apache::TestUtil?
Basic code is below. I've also got tests I can provide after working
in feedback.
Thanks,
Jim
==========================================
Jim Brandt
Administrative Computing Services
University at Buffalo
use strict;
use warnings;
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest qw( GET GET_BODY );
use GTop;
=pod
=head1 t_mem
This function attempts to watch a mod_perl process to determine
if its memory use is stable. It gets the size of a process, requests
the indicated mod_perl resource the requested number of times,
then checks the memory again.
required params:
url => the page to hit on the test server
optional params:
request_count => number of times to hit the resource; default is 10
tolerance => percentage within which the test is considered
successful
Return values:
In scalar context, t_mem returns 1 for true or undef for false.
In array context, t_mem looks like this:
my ($result, $pre_test_mem, $post_test_mem, $difference,
$percent_diff) =
t_mem({ url => '/test.cgi', request_count => 100, tolerance =>
0 });
where:
$result is the true or false value,
$pre_test_mem is the memory in (bytes?) before the test
$post_test_mem is the memory in (bytes?) after the test
$difference is the difference between the two which is how much the
process grew
$percent_diff is the percentage difference used to determine if it was
within tolerance.
=cut
sub t_mem{
my ($arg_ref) = @_;
my $DEF_REQUEST_COUNT = 10;
my $DEF_TOLERANCE = 0;
die "No url passed."
if not defined $arg_ref->{url};
# Set defaults
my $request_count = exists $arg_ref->{request_count} ? $arg_ref->
{request_count} : $DEF_REQUEST_COUNT;
my $tolerance = exists $arg_ref->{tolerance} ? $arg_ref->
{tolerance} : $DEF_TOLERANCE;
# Set process to hit.
my $pid = &get_pid();
# Tie requests to one child to make sure we are really hitting it.
my $same_interp = Apache::TestRequest::same_interp_tie($arg_ref->
{url});
my $res = Apache::TestRequest::same_interp_do($same_interp,
\&GET, $arg_ref->{url});
my $pre_process_size = &get_process_size($pid);
for (my $i=1; $i<=$request_count; $i++){
$res = Apache::TestRequest::same_interp_do
( $same_interp, \&GET, $arg_ref->{url} );
unless ($res->code == 200){
die "Failed page load for $arg_ref->{url} on iteration $i";
}
}
# Get process size again.
my $post_process_size = &get_process_size($pid);
# Compare and return results.
my $diff = $post_process_size - $pre_process_size;
# Calculate percent difference.
my $percent_diff = ($diff * 100) / $pre_process_size;
my $result;
if ( $percent_diff <= $tolerance ){
$result = 1;
}
if (wantarray){
return ($result, $pre_process_size, $post_process_size, $diff,
$percent_diff);
}
return $result;
}
sub get_pid{
# Is there a better way to get the process id?
my $status = GET_BODY('/server-status');
$_ = $status;
my $pid = $1 if /(\d+)\sin state/m;
unless( $pid ){
die "Can't get process id.";
}
return $pid;
}
sub get_process_size{
my $pid = shift;
my $gtop = GTop->new;
die "Unable to get process memory."
unless (my $proc_mem = $gtop->proc_mem($pid));
die "Unable to get real memory size."
unless (my $rss = $proc_mem->rss);
return $rss;
}
sub size_string {
# Use this for nicer formating of results?
my($size) = @_;
if (!$size) {
$size = " 0K";
}
elsif ($size == -1) {
$size = " -";
}
elsif ($size < 1024) {
$size = " 1K";
}
elsif ($size < 1048576) {
$size = sprintf "%4dK", ($size + 512) / 1024;
}
elsif ($size < 103809024) {
$size = sprintf "%4.1fM", $size / 1048576.0;
}
else {
$size = sprintf "%4dM", ($size + 524288) / 1048576;
}
return $size;
}
1;
