bt-aggregate

#!/usr/bin/env perl
# This program is part of Aspersa (http://code.google.com/p/aspersa/)

=pod

=head1 NAME

bt-aggregate - Aggregate and print GDB backtraces.

=head1 SYNOPSIS

  gdb -ex "set pagination 0" -ex "thread apply all bt" --batch \
    -p $(pidof mysqld) > backtrace.txt
  bt-aggregate backtrace.txt

For more compact output, set the AS_COMPACT environment variable.

=head1 OPTIONS

=over

=item -n

Aggregate by only the first N lines of each trace.

=back

=head1 AUTHOR

Baron Schwartz

=cut
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);

# Look for command-line arguments to see if we're supposed to aggregate by only
# the first few lines of each stack trace.
my $n_lines = 0;
if ( @ARGV && $ARGV[0] =~ m/^-\d/ ) {
   my $arg = shift @ARGV;
   ($n_lines) = $arg =~ m/(\d+)/;
}

local $INPUT_RECORD_SEPARATOR = ''; # Paragraph mode

my %traces;

while ( my $chunk = <> ) {
   next unless my ( $tid ) = $chunk =~ m/^Thread (\d+)/;
   $chunk =~ s/\AThread.*$//m;                  # Delete first line
   $chunk =~ s/#$n_lines\s.*//s if $n_lines;    # Delete all but first N lines
   $chunk =~ s/(\A\s+)|(\s+\Z)//g;              # Trim whitespace
   # Grab the signature of the chunk.
   my $sig = join(',', $chunk =~ m/(^#\d+.*?)\(/gm);
   $traces{$sig}->{count}++;
   $traces{$sig}->{sample} ||= $chunk;
   push @{$traces{$sig}->{tids}}, $tid;
}

foreach my $sig (
   reverse sort { $traces{$a}->{count} <=> $traces{$b}->{count} } keys %traces
) {
   my $trace = $traces{$sig}->{sample};
   if ( $ENV{AS_COMPACT} ) {
      printf "%4d %s\n", $traces{$sig}->{count},
         join(', ', map { "$_()" } $trace =~ m/ in (\S+) /g);
   }
   else {
      printf "%4d threads with the following stack trace:\n", $traces{$sig}->{count};
      $trace =~ s/^/\t/gm;
      print $trace, "\n\n";
   }
}