analyze-hprof.pl

# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

binmode STDOUT, ":utf8";

my %traces = ();
my $root = { 'count' => 0, 'frame' => 'root', 'children' => {} };
my $leaf = { 'count' => 0, 'frame' => 'leaf', 'children' => {} };

sub accumulate {
  my ($trace, $count) = @_;

  $root->{'count'} += $count;
  my $info = $root;
  for my $frame (@{$traces{$trace}}) {
    my $children = $info->{'children'};
    $children->{$frame} or $children->{$frame} = {
      'count' => 0,
      'frame' => $frame,
      'children' => {}
    };
    $info = $children->{$frame};
    $info->{'count'} += $count;
  }

  $leaf->{'count'} += $count;
  my $info = $leaf;
  for my $frame (reverse @{$traces{$trace}}) {
    my $children = $info->{'children'};
    $children->{$frame} or $children->{$frame} = {
      'count' => 0,
      'frame' => $frame,
      'children' => {}
    };
    $info = $children->{$frame};
    $info->{'count'} += $count;
  }
}

sub output {
  my ($total, $info, $prefix) = @_;

  my @children = values %{$info->{'children'}};
  @children = grep { $_->{'count'} * 50 > $total } @children or return;
  @children = sort { $b->{'count'} - $a->{'count'} } @children;

  my $last = $children[-1];
  for my $child (@children) {
    printf "%s%s%d%% %s\n",
      $prefix,
      ($child == $last) ? "\x{2514}" : "\x{251c}",
      $child->{'count'} * 100 / $total,
      $child->{'frame'};
    output($total, $child, ($child == $last) ? "$prefix " : "$prefix\x{2502}");
  }
}

my $trace = '';
while (<>) {
  /^TRACE (\d+)/  and $trace = $1 and $traces{$trace} = [] and next;
  /^\s+(?:org\.apache\.jackrabbit\.)?([a-z].*?)(\(.*)?\r?\n/ and $trace and $traces{$trace} = [ $1, @{$traces{$trace}} ] and next;
  /^rank/ and $trace and $trace = '' and next;
  /^\s*\d+\s+\S+%\s+\S+%\s+(\d+)\s+(\d+)/ and accumulate($2, $1); 
}

print "Caller tree\n===========\n";
output($root->{'count'}, $root, "");
print "Callee tree\n===========\n";
output($leaf->{'count'}, $leaf, "");