~ubuntu-branches/ubuntu/gutsy/virtualbox-ose/gutsy

« back to all changes in this revision

Viewing changes to src/libs/xpcom18a4/xpcom/tools/analyze-xpcom-log.pl

  • Committer: Bazaar Package Importer
  • Author(s): Steve Kowalik
  • Date: 2007-09-08 16:44:58 UTC
  • Revision ID: james.westby@ubuntu.com-20070908164458-wao29470vqtr8ksy
Tags: upstream-1.5.0-dfsg2
ImportĀ upstreamĀ versionĀ 1.5.0-dfsg2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#!/usr/local/bin/perl -w
 
2
 
 
3
# Perl script to analyze the xpcom output file
 
4
#
 
5
# To create xpcom output file :
 
6
#
 
7
# setenv NSPR_LOG_MODULES nsComponentManager:5
 
8
# setenv NSPR_LOG_FILE xpcom.out
 
9
# ./mozilla
 
10
#
 
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
 
13
#
 
14
# $ regExport > reg.out
 
15
#
 
16
# Usage: analyze-xpcom-log.pl < xpcom.out
 
17
# [does better if ./reg.out is available]
 
18
#
 
19
# Suresh Duddi <dpsuresh@netscape.net>
 
20
 
 
21
 
 
22
use strict;
 
23
 
 
24
# forward declarations
 
25
sub getContractID($);
 
26
sub sum($);
 
27
 
 
28
# Configuration parameters
 
29
# Print all ?
 
30
my $all = 0;
 
31
 
 
32
# hash of cid -> contractid
 
33
my %contractid;
 
34
my %contractid_n;
 
35
my %failedContractid_n;
 
36
 
 
37
# count of instances of objects created
 
38
my (%objs, %objs_contractid, %failedObjs) = ();
 
39
 
 
40
# dlls loaded
 
41
my @dlls;
 
42
 
 
43
# temporaries
 
44
my ($cid, $n, $str);
 
45
 
 
46
while (<>) {
 
47
    chomp;
 
48
 
 
49
    # dlls loaded
 
50
    if (/loading \"(.*)\"/) {
 
51
        push @dlls, $1;
 
52
        next;
 
53
    }
 
54
 
 
55
    # FAILED ContractIDToClassID
 
56
    if (/ContractIDToClassID\((.*)\).*\[FAILED\]/) {
 
57
        $failedContractid_n{$1}++;
 
58
        next;
 
59
    }
 
60
 
 
61
    # ContractIDToClassID
 
62
    if (/ContractIDToClassID\((.*)\).*\{(.*)\}/) {
 
63
        $contractid{$2} = $1;
 
64
        $contractid_n{$2}++;
 
65
        next;
 
66
    }
 
67
 
 
68
    # CreateInstance()
 
69
    if (/CreateInstance\(\{(.*)\}\) succeeded/) {
 
70
        $objs{$1}++;
 
71
        next;
 
72
    }
 
73
 
 
74
    # CreateInstanceByContractID()
 
75
    if (/CreateInstanceByContractID\((.*)\) succeeded/) {
 
76
        $objs_contractid{$1}++;
 
77
        next;
 
78
    }
 
79
 
 
80
    # FAILED CreateInstance()
 
81
    if (/CreateInstance\(\{(.*)\}\) FAILED/) {
 
82
        $failedObjs{$1}++;
 
83
        next;
 
84
    }
 
85
}
 
86
 
 
87
# if there is a file named reg.out in the current dir
 
88
# then use that to fill in the ContractIDToClassID mapping.
 
89
my $REG;
 
90
open REG, "<reg.out";
 
91
while (<REG>) {
 
92
    chomp;
 
93
    if (/contractID -  (.*)$/) {
 
94
        my $id = $1;
 
95
        $cid = <REG>;
 
96
        chomp($cid);
 
97
        $cid =~ s/^.*\{(.*)\}.*$/$1/;
 
98
        $contractid{$cid} = $id;
 
99
    }
 
100
}
 
101
 
 
102
# print results
 
103
# ----------------------------------------------------------------------
 
104
 
 
105
# dlls loaded
 
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];
 
110
}
 
111
print "\n";
 
112
 
 
113
# Objects created
 
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);
 
119
}
 
120
print "\n";
 
121
 
 
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);
 
127
}
 
128
print "\n";
 
129
 
 
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);
 
136
}
 
137
print "\n";
 
138
 
 
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);
 
145
}
 
146
print "\n";
 
147
 
 
148
 
 
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;
 
155
}
 
156
print "\n";
 
157
 
 
158
 
 
159
# Subroutines
 
160
 
 
161
sub getContractID($) {
 
162
    my $cid = shift;
 
163
    my $ret = "";
 
164
    $ret = $contractid{$cid} if (exists $contractid{$cid});
 
165
    return $ret;
 
166
}
 
167
 
 
168
sub sum($) {
 
169
    my $hash_ref = shift;
 
170
    my %hash = %$hash_ref;
 
171
    my $total = 0;
 
172
    my $key;
 
173
    foreach $key (keys %hash) {
 
174
        $total += $hash{$key};
 
175
    }
 
176
    return $total;
 
177
}