stackcollapse-phpspy.pl

#!/usr/bin/env perl
#
# stackcolllapse-phpspy.pl  collapse phpspy samples into single lines.
#
# Parses php samples generated by phpspy and outputs stacks as
# single lines, with methods separated by semicolons, and then a space and an
# occurrence count. For use with flamegraph.pl.
#
# USAGE: ./stackcollapse-phpspy.pl infile > outfile
#
# Example Input:
#   ...
#   0 sleep <internal>:-1
#   1 aaa /home/mlauter/profiling/sample.php:5
#   2 bbb /home/mlauter/profiling/sample.php:10
#   3 <main> /home/mlauter/profiling/sample.php:25
#   # - - -
#   0 sleep <internal>:-1
#   1 aaa /home/mlauter/profiling/sample.php:5
#   2 <main> /home/mlauter/profiling/sample.php:28
#   # - - -
#   0 sleep <internal>:-1
#   1 aaa /home/mlauter/profiling/sample.php:5
#   2 bbb /home/mlauter/profiling/sample.php:10
#   3 ccc /home/mlauter/profiling/sample.php:15
#   4 <main> /home/mlauter/profiling/sample.php:22
#   # - - -
#   ...
#
# Example Output:
#   <main>;ccc;bbb;aaa 1
#   <main>;aaa 1
#   <main>;bbb;aaa;sleep 1
#
# To make a flamegraph:
# ./stackcollapse-phpspy.pl infile | ./vendor/flamegraph.pl > svg.out

use strict;
use warnings;

use Getopt::Long qw(:config gnu_getopt no_ignore_case);
use Encode qw(decode encode);

# parameters
my $help = 0;

sub usage {
    die <<USAGE_END;
USAGE: $0 [options] infile > outfile\n
    --h|help     # print this message
USAGE_END
}

GetOptions(
    'help|h' => \$help
) or usage();
usage() if $help;

# internals
my %stacks;
my @frames;

while (defined(my $line = <>)) {
    next unless $line =~ /^(?:#|\d+) \S/;

    my ($depth, $func) = (split ' ', $line)[0,1];

    # decode the utf-8 bytes and make them into characters
    # and turn anything that's invalid into U+FFFD
    $func = decode("utf-8", $func);

    # Convert codepoints that break XML to ?
    $func =~ s/[\x01-\x08\x0B-\x0C\x0E-\x1F\x7F-\x84\x86-\x9F]/\x3F/g;

    # turn it back into a string
    $func = encode("utf-8", $func);

    if ($depth ne '#' && $depth == 0) {
        $stacks{join(';', reverse @frames)} += 1 if @frames;
        @frames = ();
    }

    push @frames, $func if $line =~ /^\d/;
}
$stacks{join(';', reverse @frames)} += 1 if @frames;

while ( my ($k, $v) = each %stacks ) {
    print "$k $v\n";
}