ClickHouse/utils/postprocess-traces/postprocess-traces.pl

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

57 lines
1.0 KiB
Perl
Raw Permalink Normal View History

2016-11-24 20:15:37 +00:00
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my @current_stack = ();
my $grouped_stacks = {};
2024-03-15 17:46:23 +00:00
sub process_stacktrace
{
my $group = \$grouped_stacks;
for my $frame (reverse @current_stack)
{
2024-04-05 08:27:13 +00:00
$group = \$$group->{children}{$frame};
2024-03-15 17:46:23 +00:00
$$group->{count} ||= 0;
++$$group->{count};
}
@current_stack = ();
}
2016-11-24 20:15:37 +00:00
while (my $line = <>)
{
chomp $line;
if ($line =~ '^#')
{
$line =~ s/^#\d+\s+//;
$line =~ s/ \([^\)]+=.+\) at / at /g;
2016-11-24 20:15:37 +00:00
push @current_stack, $line;
}
if ($line eq '')
{
2024-03-15 17:46:23 +00:00
process_stacktrace();
2016-11-24 20:15:37 +00:00
}
}
2024-03-15 17:46:23 +00:00
process_stacktrace();
2016-11-24 20:15:37 +00:00
sub print_group
{
my $group = shift;
my $level = shift || 0;
for my $key (sort { $group->{children}{$b}{count} <=> $group->{children}{$a}{count} } keys %{$group->{children}})
{
2024-04-05 08:27:13 +00:00
my $count = $group->{children}{$key}{count};
2016-11-24 20:15:37 +00:00
print(('| ' x $level) . $count . (' ' x (5 - (length $count))) . $key . "\n");
print_group($group->{children}{$key}, $level + 1);
}
}
print_group($grouped_stacks);