phpspy/stackcollapse-phpspy.pl at master · adsr/phpspy · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
#!/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 @stack;
my %chunks; # trace id => { chunk_k => [stack] }

while (defined(my $line = <>)) {
    chomp $line;

    # if blank line, flush
    if ($line eq '') {
        $stacks{join(';', reverse @stack)} += 1 if @stack;
        @stack = ();
        next;
    }

    # skip lines not beginning with a hash or a number
    next unless $line =~ /^(?:#|\d+) \S/;

    # if this is part of a chunked trace (has trace_id metadata)...
    if ($line =~ m{^# trace_id = (\d+)\.(\d+)(.)}) {

        # save stack to chunks hash
        my ($id, $k, $m) = ($1, $2, $3);
        $chunks{$id}{$k} = [@stack];
        @stack = ();

        # if this is the final chunk, flush
        if ($m eq '!') {
            my @chunk_keys = sort { $a <=> $b } keys %{$chunks{$id}};
            if (@chunk_keys == $k + 1 && $chunk_keys[-1] == $k) {
                my @frames;
                push @frames, @{$chunks{$id}{$_}} for @chunk_keys;
                $stacks{join(';', reverse @frames)} += 1 if @frames;
            }
            delete $chunks{$id};
        }
        next;
    }

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

    # we only care about stack frames from here on
    next if $depth eq '#';

    # strip chars that break xml
    $func = decode("utf-8", $func);
    $func =~ s/[\x01-\x08\x0B-\x0C\x0E-\x1F\x7F-\x84\x86-\x9F]/\x3F/g;
    $func = encode("utf-8", $func);

    # push to stack
    push @stack, $func;
}
$stacks{join(';', reverse @stack)} += 1 if @stack;

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