#!/usr/bin/perl

use strict;
use warnings;

use Devel::DProfPP;
my $pp = Devel::DProfPP->new;

=head1 USAGE

  mydprofpp my_sub 5
  mydprofpp my_sub -2

=cut


my $func = shift || '__any__';
my $depth = shift || 1;

my %res = ();

if ( $depth > 0 ) {
	Devel::DProfPP->new(
		file    => "tmon.out",
		enter   => sub {
			my ($self, $sub_name) = @_;
			return if $func ne '__any__' && $sub_name ne $func;
			my $key = join "\n\t", map $_? $_->sub_name: '', ($self->stack)[(-1-$depth)..-2];
			$res{ $key }++;
		},
	)->parse;
} else {
	if ( $func eq '__any__' ) {
		print STDERR "doesn't support any function and negative depth\n";
		exit 1;
	}
	my $track = 0;
	my $deep = 0;
	my $enter = 1;
	$depth = abs $depth;
	Devel::DProfPP->new(
		file    => "tmon.out",
		enter   => sub {
			my ($self, $sub_name) = @_;
			$track++ if $sub_name eq $func;
			return unless $track;
			$enter = 1; $deep++;
		},
		leave   => sub {
			my ($self, $sub_name) = @_;
			return unless $track;
			$track-- if $sub_name eq $func;
			return if --$deep > $depth;

			my $flag = 0;
			my $key = join "\n\t",
			          grep $_ && ($flag || do {$_ eq $func? $flag = 1: 0; 0}),
			          map $_? $_->sub_name: '', ($self->stack);

			$res{ $key }++ if $enter;
			$enter = 0;
		}
	)->parse;
}

my $sum = 0;
foreach ( sort { $res{$a}<=>$res{$b} } keys %res ) {
	print "$_\n\t\t$res{ $_ }\n";
	$sum += $res{ $_ };
}
print "Total: $sum\n";