xpcom/tools/analyze-xpcom-log.pl

   1 #!/usr/local/bin/perl -w
   2 # This Source Code Form is subject to the terms of the Mozilla Public
   3 # License, v. 2.0. If a copy of the MPL was not distributed with this
   4 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   5
   6
   7 # Perl script to analyze the xpcom output file
   8 #
   9 # To create xpcom output file :
  10 #
  11 # setenv NSPR_LOG_MODULES nsComponentManager:5
  12 # setenv NSPR_LOG_FILE xpcom.out
  13 # ./mozilla
  14 #
  15 # Also to try to convert CID -> contractID this program looks for
  16 # a file reg.out in the current directory. To generate this file
  17 #
  18 # $ regExport > reg.out
  19 #
  20 # Usage: analyze-xpcom-log.pl < xpcom.out
  21 # [does better if ./reg.out is available]
  22 #
  23 # Suresh Duddi <dpsuresh@netscape.net>
  24
  25
  26 use strict;
  27
  28 # forward declarations
  29 sub getContractID($);
  30 sub sum($);
  31
  32 # Configuration parameters
  33 # Print all ?
  34 my $all = 0;
  35
  36 # hash of cid -> contractid
  37 my %contractid;
  38 my %contractid_n;
  39 my %failedContractid_n;
  40
  41 # count of instances of objects created
  42 my (%objs, %objs_contractid, %failedObjs) = ();
  43
  44 # dlls loaded
  45 my @dlls;
  46
  47 # temporaries
  48 my ($cid, $n, $str);
  49
  50 while (<>) {
  51     chomp;
  52
  53     # dlls loaded
  54     if (/loading \"(.*)\"/) {
  55         push @dlls, $1;
  56         next;
  57     }
  58
  59     # FAILED ContractIDToClassID
  60     if (/ContractIDToClassID\((.*)\).*\[FAILED\]/) {
  61         $failedContractid_n{$1}++;
  62         next;
  63     }
  64
  65     # ContractIDToClassID
  66     if (/ContractIDToClassID\((.*)\).*\{(.*)\}/) {
  67         $contractid{$2} = $1;
  68         $contractid_n{$2}++;
  69         next;
  70     }
  71
  72     # CreateInstance()
  73     if (/CreateInstance\(\{(.*)\}\) succeeded/) {
  74         $objs{$1}++;
  75         next;
  76     }
  77
  78     # CreateInstanceByContractID()
  79     if (/CreateInstanceByContractID\((.*)\) succeeded/) {
  80         $objs_contractid{$1}++;
  81         next;
  82     }
  83
  84     # FAILED CreateInstance()
  85     if (/CreateInstance\(\{(.*)\}\) FAILED/) {
  86         $failedObjs{$1}++;
  87         next;
  88     }
  89 }
  90
  91 # if there is a file named reg.out in the current dir
  92 # then use that to fill in the ContractIDToClassID mapping.
  93 my $REG;
  94 open REG, "<reg.out";
  95 while (<REG>) {
  96     chomp;
  97     if (/contractID -  (.*)$/) {
  98         my $id = $1;
  99         $cid = <REG>;
 100         chomp($cid);
 101         $cid =~ s/^.*\{(.*)\}.*$/$1/;
 102         $contractid{$cid} = $id;
 103     }
 104 }
 105
 106 # print results
 107 # ----------------------------------------------------------------------
 108
 109 # dlls loaded
 110 print "dlls loaded [", scalar @dlls, "]\n";
 111 print "----------------------------------------------------------------------\n";
 112 for ($n = 0; $n < scalar @dlls; $n++) {
 113     printf "%2d. %s\n", $n+1, $dlls[$n];
 114 }
 115 print "\n";
 116
 117 # Objects created
 118 print "Object creations from CID [", sum(\%objs), "]\n";
 119 print "----------------------------------------------------------------------\n";
 120 foreach $cid (sort {$objs{$b} <=> $objs{$a} } keys %objs) {
 121     last if (!$all && $objs{$cid} < 50);
 122     printf "%5d. %s - %s\n", $objs{$cid}, $cid, getContractID($cid);
 123 }
 124 print "\n";
 125
 126 print "Object creations from ContractID [", sum(\%objs_contractid), "]\n";
 127 print "----------------------------------------------------------------------\n";
 128 foreach $cid (sort {$objs_contractid{$b} <=> $objs_contractid{$a} } keys %objs_contractid) {
 129     last if (!$all && $objs_contractid{$cid} < 50);
 130     printf "%5d. %s - %s\n", $objs_contractid{$cid}, $cid, getContractID($cid);
 131 }
 132 print "\n";
 133
 134 # FAILED Objects created
 135 print "FAILED Objects creations [", sum(\%failedObjs), "]\n";
 136 print "----------------------------------------------------------------------\n";
 137 foreach $cid (sort {$failedObjs{$b} <=> $failedObjs{$a} } keys %failedObjs) {
 138     last if (!$all && $failedObjs{$cid} < 50);
 139     printf "%5d. %s - %s", $failedObjs{$cid}, $cid, getContractID($cid);
 140 }
 141 print "\n";
 142
 143 # ContractIDToClassID calls
 144 print "ContractIDToClassID() calls [", sum(\%contractid_n),"]\n";
 145 print "----------------------------------------------------------------------\n";
 146 foreach $cid (sort {$contractid_n{$b} <=> $contractid_n{$a} } keys %contractid_n) {
 147     last if (!$all && $contractid_n{$cid} < 50);
 148     printf "%5d. %s - %s\n", $contractid_n{$cid}, $cid, getContractID($cid);
 149 }
 150 print "\n";
 151
 152
 153 # FAILED ContractIDToClassID calls
 154 print "FAILED ContractIDToClassID() calls [", sum(\%failedContractid_n), "]\n";
 155 print "----------------------------------------------------------------------\n";
 156 foreach $cid (sort {$failedContractid_n{$b} <=> $failedContractid_n{$a} } keys %failedContractid_n) {
 157     last if (!$all && $failedContractid_n{$cid} < 50);
 158     printf "%5d. %s\n", $failedContractid_n{$cid}, $cid;
 159 }
 160 print "\n";
 161
 162
 163 # Subroutines
 164
 165 sub getContractID($) {
 166     my $cid = shift;
 167     my $ret = "";
 168     $ret = $contractid{$cid} if (exists $contractid{$cid});
 169     return $ret;
 170 }
 171
 172 sub sum($) {
 173     my $hash_ref = shift;
 174     my %hash = %$hash_ref;
 175     my $total = 0;
 176     my $key;
 177     foreach $key (keys %hash) {
 178         $total += $hash{$key};
 179     }
 180     return $total;
 181 }