gistfile1.txt

BEGIN {
  # Only load up the callback if Devel::MemoryTrace::Light is being used
  if ($Devel::MemoryTrace::Light::VERSION) {

        my %stats;

        # Override default output when memory change is detected
        DB::set_callback(
          sub  {
                my ($pkg, $file, $line, $bytes) = @_;

                $stats{'package'}{$pkg}            += $bytes;
                $stats{'file'}{$file}              += $bytes;
                $stats{'file/line'}{"$file:$line"} += $bytes;

                print "$pkg, $file, $line, $bytes\n";
          }
        );
        
        END {
          # END blocks get called regardless of if (); need to check again
          if ($Devel::MemoryTrace::Light::VERSION) {
        
                # Don't trace this end block!
                DB::disable_trace();

                for my $key (qw( package file file/line )) {
                        my @top = reverse sort {
                                $stats{$key}{$a} <=> $stats{$key}{$b}
                        } keys %{ $stats{$key} };
        
                        my $max = scalar @top > 5 ? 5 : scalar @top;

                        print "Top $max memory users by $key\n";
        
                        for my $idx (0..$max - 1) {
                                print "\t$stats{$key}{$top[$idx]}: $top[$idx]\n";
                        }
                }
        
                DB::enable_trace();
          }
        }
  }
}