File Coverage

blib/lib/Devel/DumpSizes.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

use strict;
use warnings;

package Devel::DumpSizes;

use PadWalker;
use Devel::Size;
use Devel::Symdump;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw (dump_sizes);
our %EXPORT_TAGS = (all => \@EXPORT_OK);

our $VERSION = "0.01";

sub dump_sizes {

	my $dump_file_prefix = shift || "";
	my $ref_of_mys = PadWalker::peek_my(1);
	my %var_sizes;
	my @sorted_vars;

	if ( $dump_file_prefix ) {
		open(DUMP, ">>$dump_file_prefix.my") or warn "Unable to open file to dump sizes\n";
	} else {
		open(DUMP, ">&STDOUT") or warn "ould not dup STDOUT\n";
	}

	print DUMP "Variable name -> Size in bytes\n";
	print DUMP '-' x 80, "\n";

	# Foreach my variable in the caller stack, get "name -> size" as told by Devel::Size::total_size
	foreach my $var_name ( keys(%$ref_of_mys) ) {
		ref($ref_of_mys->{$var_name}) ? $var_sizes{$var_name} = Devel::Size::total_size($ref_of_mys->{$var_name})
			: $var_sizes{$var_name} = Devel::Size::total_size(\$ref_of_mys->{$var_name});
	}
	@sorted_vars = map { "$_ -> $var_sizes{$_}" } sort { $var_sizes{$b} <=> $var_sizes{$a} } (keys(%var_sizes));

	if ( caller(1) ) {
		print DUMP '-' x 30, 'my : ', time(), ' : ', @{[caller(1)]}[3], '/', @{[caller(1)]}[2], '-' x 30, "\n";
	    } else {
		print DUMP '-' x 30, 'my : ', time(), '-' x 40, "\n";
	    }
	print DUMP join("\n", @sorted_vars), "\n";
	print DUMP '-' x 80, "\n";
	close(DUMP);

	my $sym_obj = Devel::Symdump->new( (caller(1))[0] );
	my @vars_array;
	if ( $dump_file_prefix ) {
		open(DUMP, ">>$dump_file_prefix.ol") or warn "Unable to open file to dump sizes\n";
	} else {
		open(DUMP, ">&STDOUT") or warn "ould not dup STDOUT\n";
	}

	# Anonymous subroutine for getting "name -> size" variables in symtab of package of caller.
	my $sub_ref = sub {
		my $var_prefix = shift;
		%var_sizes = ();
		@sorted_vars = ();

		# Foreach our/local variable in the symbol table of caller's package, get "name -> size"
		if ( $var_prefix eq '$' ) {
			foreach my $var_name (@vars_array) {
				no strict 'refs';
				if ( $$var_name ) {
					ref($$var_name) ? $var_sizes{$var_name} = Devel::Size::total_size($$var_name)
					: $var_sizes{$var_name} = Devel::Size::size($$var_name);
				} else {
					$var_sizes{$var_name} = 0;
				}
			}
		} elsif ( $var_prefix eq '@' ) {
			foreach my $var_name (@vars_array) {
				no strict 'refs';
				if ( @$var_name ) {
					$var_sizes{$var_name} = Devel::Size::total_size(\@$var_name);
				} else {
					$var_sizes{$var_name} = 0;
				}
			}
		} elsif ( $var_prefix eq '%' ) {
			foreach my $var_name (@vars_array) {
				no strict 'refs';
				if ( %$var_name ) {
					$var_sizes{$var_name} = Devel::Size::total_size(\%$var_name);
				} else {
					$var_sizes{$var_name} = 0;
				}
			}
		}

		@sorted_vars = map { "$var_prefix$_ -> $var_sizes{$_}" } sort { $var_sizes{$b} <=> $var_sizes{$a} } (keys(%var_sizes));
		if ( caller(2) ) {
			print DUMP '-' x 30, 'our/local : ', time(), ' : ', @{[caller(2)]}[3], '/', @{[caller(2)]}[2], '-' x 30, "\n";
		} else {
			print DUMP '-' x 30, 'our/local : ', time(), '-' x 40, "\n";
		}
		print DUMP join("\n", @sorted_vars), "\n";
		print DUMP '-' x 80, "\n";

		@vars_array = ();
	};

	@vars_array = $sym_obj->scalars;
	$sub_ref->('$');
	@vars_array = $sym_obj->arrays;
	$sub_ref->('@');
	@vars_array = $sym_obj->hashes;
	$sub_ref->('%');
	close(DUMP);
}

1;
__END__