79 lines
1.9 KiB
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{$_}, $_; |
|
} |
|
|
|
|