tags/v1_29/Leak/Leak.pm

package Apache::Leak;

use strict;
use DynaLoader ();
use Exporter ();
*import = \&Exporter::import;
{
    no strict;
    @EXPORT = qw(leak_test);
    $VERSION = '1.00';
    @ISA = qw(DynaLoader);
    __PACKAGE__->bootstrap($VERSION);
}

sub LOOP_N () {2}

sub leak_test (&;$$) {
    my($cv, $x, $fh) = @_;
    $x  ||= LOOP_N;
    $fh ||= \*STDERR;
    my $first = $x;

    while($x--) {
	my $handle;
	my $enter = NoteSV($handle);
	my $leave = 0;
	print $fh "ENTER: $enter SVs\n";
	{
	    $cv->();
	}
	$leave = CheckSV($handle);
	print $fh "\nLEAVE: $leave SVs\n";
	if($enter != $leave) {
	    my $n = $leave - $enter;
	    if($x+1 == $first) {
	    }
	    else {
		print $fh "!!! $n SVs leaked !!!\n";
	    }
	}
    }
}

sub handler {
    my $r = shift; 
    my $uri = $r->uri;
    my $handle;
    my $count = NoteSV($handle);
    $r->push_handlers(PerlLogHandler => sub {
	warn "Leak test for $uri:\n";
        warn "  ENTER: $count SVs\n";
        $count = CheckSV($handle);
        warn "  LEAVE: $count SVs\n";
    });
    0;
}

1;
__END__

=head1 NAME

Apache::Leak - Module for tracking memory leaks in mod_perl code

=head1 SYNOPSIS

    use Apache::Leak;

    leak_test {
	my $obj = Foo->new;
	$obj->thingy;
    };
    #now look in error_log for results

=head1 DESCRIPTION

"Under Construction."

=head1 SEE ALSO

Devel::Leak

=head1 AUTHOR

Doug MacEachern
Leak.xs derived from Nick Ing-Simmons' Devel::Leak