79 lines
1.9 KiB

#!/usr/bin/perl -w
#
# --- SDE-COPYRIGHT-NOTE-BEGIN ---
# This copyright note is auto-generated by ./scripts/Create-CopyPatch.
#
# Filename: package/.../oprofile/pulpstoner.pl
# Copyright (C) 2004 - 2006 The T2 SDE Project
# Copyright (C) 1998 - 2003 Clifford Wolf
#
# More information can be found in the files COPYING and README.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License. A copy of the
# GNU General Public License can be found in the file COPYING.
# --- SDE-COPYRIGHT-NOTE-END ---
use English;
use strict;
my $min_samples = 1000;
my $min_percent = 2;
my $min_points = 10;
my %roots;
my %percents;
my %files;
my %binaries;
my $bin;
sub read_pkgdb($) {
my $root=$_[0];
print "Reading package DB from /$root ...\n";
open(F, "cat /${root}var/adm/flists/*|") || die $!;
while (<F>) {
chomp; @_ = split /:\s+/;
$files{${root}.$_[1]} = $_[0];
}
close F;
}
read_pkgdb("");
my $pc = 0;
open(F, "opreport -f -n | sort -r -g -k 2|") || die $!;
for (<F>) {
@_ = split /\s+/; $pc+=$_[2];
last if $_[1] < $min_samples;
last if $pc > 100-$min_percent;
next unless -f $_[3];
$_[3] =~ s,^/,,;
$binaries{$_[3]} = $_[2];
}
close F;
foreach $bin (keys %binaries) {
if ( $bin =~ m,(.*/root/), and not defined $roots{$1} ) {
$roots{$1} = 1;
read_pkgdb($1);
}
if ( not defined $files{$bin} ) {
print "Not found in package db: $bin\n";
next;
}
open(F, "opreport -g --symbols -n /$bin|") || die $!;
while (<F>) {
next if /\(no location information\)/;
my ($count, $percent, $src, $sym) = split /\s+/; $src =~ s/:.*//;
$percents{sprintf "%-14s\t%-22s\t%s",
$files{$bin}, $src, $bin} += $percent * $binaries{$bin};
}
close F;
}
foreach (keys %percents) {
next if $percents{$_} < $min_points;
printf "** %9.2f:\t%s\n", $percents{$_}, $_;
}