package Devel::MemoryTrace::Light;

	$Devel::MemoryTrace::Light::VERSION = '0.06';

use strict;
use warnings;

my $trace;                # Tracing enabled by default (set after ENV handling)
my $trace_immediate  = 0; # Compile-time tracing disabled by default
my $mem_class;

if (my $opts = $ENV{MEMORYTRACE_LIGHT}) {
	for my $opt (split(':', $opts)) {
		my ($key, $val) = split('=', $opt);

		if ($key eq 'start') {
			if ($val eq 'no') {
				$trace = 0;
			} elsif ($val eq 'begin') {
				$trace_immediate = 1;
			} else {
				warn "Ignoring unknown value ($val) for 'start'\n";
		} elsif ($key eq 'provider') {
			eval "use $val";

			die "Custom provider ($val) failed to load: $@\n" if $@;

			die "Custom provider ($val) failed to load: No get_mem() method found\n"
				unless $val->can('get_mem');

			die "Custom provider ($val) failed to load: get_mem() didn't return an integer\n"
				unless $val->get_mem() =~ /\A\d+\Z/;

			$mem_class = $val;
		} else {
			warn "Ignoring unknown config option ($key)\n";

# Trace enabled by default. Set down here incase die() is called above
$trace = 1 unless defined $trace;

unless ($mem_class) {
	my @mod_preference = qw(

	if ($^O ne 'freebsd') {
		shift @mod_preference;

	for my $p (@mod_preference) {
		eval "use $p";

		unless ($@) {
			$mem_class = $p; last;

	unless ($mem_class) {
		die "No suitable memory examiner found!\n";

package DB;

use strict;
use warnings;

# Disables tracing after compile-time if start=no was set
	$DB::single = $trace;

my $callback = \&_report;

my $last_mem = $mem_class->get_mem();
my @last_id  = ('init', 0, 0);

my $pid = $$;

sub set_callback (&) {
	$callback = $_[0];

sub restore_callback () {
	$callback = \&_report;

sub enable_trace () {
	# Memory tracing has been disabled, update our state
	if ($pid != $$) {
		$mem_class->forked() if $mem_class->can('forked');

		$pid = $$;

	$last_mem = $mem_class->get_mem();
	@last_id = caller();

	$DB::single = 1;

sub disable_trace () {
	$DB::single = 0;

sub _report {
	my ($pkg, $file, $line, $mem) = @_;

	printf(">> $$ $pkg, $file ($line) used %d bytes\n", $mem);

sub DB {
	if ($pid != $$) {
		$mem_class->forked() if $mem_class->can('forked');

		$pid = $$;

	my $newmem = $mem_class->get_mem();

	if ($newmem > $last_mem) {
		$callback->(@last_id, $newmem - $last_mem);

		$last_mem = $newmem;

	@last_id = caller();

	if ($DB::single) {
		# Force last line to be evaluated for memory growth

		# Otherwise we'll probably crash

# This must go at the end (so we don't trace our own compilation)
if ($trace_immediate) {
	$DB::single = 1;


# ABSTRACT: A simple lightweight memory-growth tracer


=head1 NAME

Devel::MemoryTrace::Light - Print a message when your program grows in memory

=head1 VERSION

version 0.06


  perl -d:MemoryTrace::Light Program


B<This is a Beta release!>

Prints out a message when your program grows in memory containing the 
B<pid>, B<package>, B<file>, B<line>, and B<number of bytes> (resident set 
size) your program increased. For example, if your program looked like this:


  use strict;
  use warnings;

  my @arr;
  $arr[4096] = 'hello';

Then the output will look like:

  >> 324 init, 0 (0) used 8192 bytes
  >> 324 main, (7) used 20480 bytes


The C<MEMORYTRACE_LIGHT> environment variable may be used to control some of the 
behaviors of Devel::MemoryTrace::Light. The format is C<key=value>, and multiple 
values may be set at one time using the C<:> separator. For example:

  export MEMORYTRACE_LIGHT=start=no:provider=MyClass

=head2 provider=...

Forces Devel::MemoryTrace::Light to use whatever class is passed in to determine 
memory usage.

The provider class I<must> define a C<get_mem()> method which should return 
the current process' memory size. The built in modules return the resident set 
size, but a custom provider could use virtual, swap, or whatever it wants, as 
long as it returns the same type of information consistently.

The provider class I<should> also define a C<forked()> method which will be 
called if Devel::MemoryTrace::Light detects that the process has forked. This method 
should do any re-initialization necessary for the provider class to accurately 
report memory for the new forked process.

The B<provider> setting may also be used to force Devel::MemoryTrace::Light to 
prefer one of the built-in providers over another if more than one is installed.

=head2 start=...

Modify when tracing happens:

  start=begin - trace compilation of the program and beyond
  start=no    - disable tracing until C<DB::enable_trace()> is called

By default, tracing doesn't happen until the beginning of the INIT phase, after 
compilation. To see where memory growth is happening inside of C<use> 
statements, use C<start=begin>.


A limited set of functionality is provided for run-time control of tracing.

=head2 DB::disable_trace()

=head2 DB::enable_trace()

You can control when tracing happens by using C<DB::enable_trace()> and 
C<DB::disable_trace>. This works well coupled with the C<start=no> 
setting in the C<MEMORYTRACE_LIGHT> environment variable described above.

=head2 DB::set_callback(\&somefunc)

If you would like to override the default behavior of printing to STDOUT 
whenever the program size increases, you may provide your own callback method.

This causes C<\&somefunc> to be called whenever the debugger detects an increase 
in memory size. C<\&somefunc> should accept 4 arguments:

=over 4

=item * $pkg

=item * $file

=item * $line

=item * $bytes


=head2 DB::restore_callback()

Restores the default callback.


Currently works on FreeBSD, Linux, and anywhere else L<GTop> is supported.

On FreeBSD, installing this module will install L<BSD::Process> unless
L<GTop> is already installed. L<BSD::Process> will be preferred if both
modules are on the system.

=head1 CAVEATS

This module only identifies lines in a program that the resident set size 
increased at. This does not mean, however, that if you have a memory leak and 
you see bizarre lines increasing in size that they must be the problem. Often 
times, that's not the case. Consider the following example:


  use strict;
  use warnings;

  my @cache;

  for (1..10_000) {

  sub nothing {
          my @arr = 5;

  sub use_mem {
          push @cache, 1;

If you run the above code under C<Devel::MemoryTrace::Light>, C<nothing()> will 
be reported as using the most memory. In reality though, C<use_mem()> is caching 
data and is the real cause of the memory consumption, but C<nothing()> causes 
more actual memory growth as it tries to create a new array and assign 
a value to its first element. 

This is because after C<use_mem()> returns and C<@arr> goes out of scope, the 
memory allocated to C<@arr> is potentially freed by the garbage collector, 
allowing C<use_mem()> to use it without having to allocate more.

=head1 BUGS

Please report any bugs (or feature requests) through L<>.

=head1 AUTHOR

Matthew Horsfall (alh) - <>


This software is copyright (c) 2011 by Matthew Horsfall.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.