package MemLeak;

use strict;
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK = qw(mlprint mlprintc);

=head1 NAME

MemLeak - Helper functions to track memory leaks

=head1 SYNOPSIS

    use MemLeak qw(mlprint mlprintc);

    mlprint('BEGIN');
    my $a = 5;
    mlprint('after $a');
    my @a = (1..10);
    mlprintc('BEGIN', 'after @a');
    my %a;
    @a{@a} = @a;
    mlprintc('BEGIN', 'after %a');

=cut

use Devel::Leak;

sub _time_now
{
    my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);

    return sprintf "%02d:%02d:%02d %02d/%02d/%02d",
	$hour, $min, $sec, $mon + 1, $day, $year - 100;
}

my $last_count = 0;

my %CHECK_POINTS = (
	_LAST	=> 0,
);

sub _get_counts
{
    my ($chkpt) = @_;

    my $handle;
    my $count = Devel::Leak::NoteSV($handle);
    my $delta = $count - $CHECK_POINTS{_LAST};
    $CHECK_POINTS{_LAST} = $count;

    my $delta_cp;
    if ($chkpt) {
	if (exists $CHECK_POINTS{$chkpt}) {
	    $delta_cp = $count - $CHECK_POINTS{$chkpt};
	    delete $CHECK_POINTS{$chkpt};
	} else {
	    $CHECK_POINTS{$chkpt} = $count;
	}
    }

    return ($count, $delta, $delta_cp);
}

=head1 DESCRIPTION

=head2 mlprint(@args)

    print current SV count and change since last count

=cut

sub mlprint
{
    my (@args) = @_;

    my ($count, $delta) = _get_counts;

    my $msg = join "", @args;
    chomp $msg if $msg;

    warn sprintf "[%d - %s] SV# = %d (%+d); %s\n",
		$$, _time_now, $count, $delta, $msg;
}

=pod

=head2 mlprintc($chkpt, @args)

    print current SV count and changes since last count
    and since the checkpoint specified

=cut

sub mlprintc
{
    my ($check_pt, @args) = @_;

    my ($count, $delta, $delta_cp) = _get_counts($check_pt);

    my $msg = join "", @args;
    chomp $msg if $msg;

    if (defined $delta_cp) {
	warn sprintf "[%d - %s] SV# = %d (%+d/%s: %+d); %s\n",
		$$, _time_now, $count, $delta, $check_pt, $delta_cp, $msg;
    } else {
	warn sprintf "[%d - %s] SV# = %d (%+d); %s: %s\n",
		$$, _time_now, $count, $delta, $check_pt, $msg;
    }
}

1;