1
#!/usr/local/bin/perl -w
3
# Perl script to analyze the xpcom output file
5
# To create xpcom output file :
7
# setenv NSPR_LOG_MODULES nsComponentManager:5
8
# setenv NSPR_LOG_FILE xpcom.out
11
# Also to try to convert CID -> contractID this program looks for
12
# a file reg.out in the current directory. To generate this file
14
# $ regExport > reg.out
16
# Usage: analyze-xpcom-log.pl < xpcom.out
17
# [does better if ./reg.out is available]
19
# Suresh Duddi <dpsuresh@netscape.net>
24
# forward declarations
28
# Configuration parameters
32
# hash of cid -> contractid
35
my %failedContractid_n;
37
# count of instances of objects created
38
my (%objs, %objs_contractid, %failedObjs) = ();
50
if (/loading \"(.*)\"/) {
55
# FAILED ContractIDToClassID
56
if (/ContractIDToClassID\((.*)\).*\[FAILED\]/) {
57
$failedContractid_n{$1}++;
62
if (/ContractIDToClassID\((.*)\).*\{(.*)\}/) {
69
if (/CreateInstance\(\{(.*)\}\) succeeded/) {
74
# CreateInstanceByContractID()
75
if (/CreateInstanceByContractID\((.*)\) succeeded/) {
76
$objs_contractid{$1}++;
80
# FAILED CreateInstance()
81
if (/CreateInstance\(\{(.*)\}\) FAILED/) {
87
# if there is a file named reg.out in the current dir
88
# then use that to fill in the ContractIDToClassID mapping.
93
if (/contractID - (.*)$/) {
97
$cid =~ s/^.*\{(.*)\}.*$/$1/;
98
$contractid{$cid} = $id;
103
# ----------------------------------------------------------------------
106
print "dlls loaded [", scalar @dlls, "]\n";
107
print "----------------------------------------------------------------------\n";
108
for ($n = 0; $n < scalar @dlls; $n++) {
109
printf "%2d. %s\n", $n+1, $dlls[$n];
114
print "Object creations from CID [", sum(\%objs), "]\n";
115
print "----------------------------------------------------------------------\n";
116
foreach $cid (sort {$objs{$b} <=> $objs{$a} } keys %objs) {
117
last if (!$all && $objs{$cid} < 50);
118
printf "%5d. %s - %s\n", $objs{$cid}, $cid, getContractID($cid);
122
print "Object creations from ContractID [", sum(\%objs_contractid), "]\n";
123
print "----------------------------------------------------------------------\n";
124
foreach $cid (sort {$objs_contractid{$b} <=> $objs_contractid{$a} } keys %objs_contractid) {
125
last if (!$all && $objs_contractid{$cid} < 50);
126
printf "%5d. %s - %s\n", $objs_contractid{$cid}, $cid, getContractID($cid);
130
# FAILED Objects created
131
print "FAILED Objects creations [", sum(\%failedObjs), "]\n";
132
print "----------------------------------------------------------------------\n";
133
foreach $cid (sort {$failedObjs{$b} <=> $failedObjs{$a} } keys %failedObjs) {
134
last if (!$all && $failedObjs{$cid} < 50);
135
printf "%5d. %s - %s", $failedObjs{$cid}, $cid, getContractID($cid);
139
# ContractIDToClassID calls
140
print "ContractIDToClassID() calls [", sum(\%contractid_n),"]\n";
141
print "----------------------------------------------------------------------\n";
142
foreach $cid (sort {$contractid_n{$b} <=> $contractid_n{$a} } keys %contractid_n) {
143
last if (!$all && $contractid_n{$cid} < 50);
144
printf "%5d. %s - %s\n", $contractid_n{$cid}, $cid, getContractID($cid);
149
# FAILED ContractIDToClassID calls
150
print "FAILED ContractIDToClassID() calls [", sum(\%failedContractid_n), "]\n";
151
print "----------------------------------------------------------------------\n";
152
foreach $cid (sort {$failedContractid_n{$b} <=> $failedContractid_n{$a} } keys %failedContractid_n) {
153
last if (!$all && $failedContractid_n{$cid} < 50);
154
printf "%5d. %s\n", $failedContractid_n{$cid}, $cid;
161
sub getContractID($) {
164
$ret = $contractid{$cid} if (exists $contractid{$cid});
169
my $hash_ref = shift;
170
my %hash = %$hash_ref;
173
foreach $key (keys %hash) {
174
$total += $hash{$key};