michael@0: #!/usr/local/bin/perl -w
michael@0: # This Source Code Form is subject to the terms of the Mozilla Public
michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0: 
michael@0: 
michael@0: # Perl script to analyze the xpcom output file
michael@0: #
michael@0: # To create xpcom output file :
michael@0: #
michael@0: # setenv NSPR_LOG_MODULES nsComponentManager:5
michael@0: # setenv NSPR_LOG_FILE xpcom.out
michael@0: # ./mozilla
michael@0: #
michael@0: # Also to try to convert CID -> contractID this program looks for
michael@0: # a file reg.out in the current directory. To generate this file
michael@0: #
michael@0: # $ regExport > reg.out
michael@0: #
michael@0: # Usage: analyze-xpcom-log.pl < xpcom.out
michael@0: # [does better if ./reg.out is available]
michael@0: #
michael@0: # Suresh Duddi <dpsuresh@netscape.net>
michael@0: 
michael@0: 
michael@0: use strict;
michael@0: 
michael@0: # forward declarations
michael@0: sub getContractID($);
michael@0: sub sum($);
michael@0: 
michael@0: # Configuration parameters
michael@0: # Print all ?
michael@0: my $all = 0;
michael@0: 
michael@0: # hash of cid -> contractid
michael@0: my %contractid;
michael@0: my %contractid_n;
michael@0: my %failedContractid_n;
michael@0: 
michael@0: # count of instances of objects created
michael@0: my (%objs, %objs_contractid, %failedObjs) = ();
michael@0: 
michael@0: # dlls loaded
michael@0: my @dlls;
michael@0: 
michael@0: # temporaries
michael@0: my ($cid, $n, $str);
michael@0: 
michael@0: while (<>) {
michael@0:     chomp;
michael@0: 
michael@0:     # dlls loaded
michael@0:     if (/loading \"(.*)\"/) {
michael@0:         push @dlls, $1;
michael@0:         next;
michael@0:     }
michael@0: 
michael@0:     # FAILED ContractIDToClassID
michael@0:     if (/ContractIDToClassID\((.*)\).*\[FAILED\]/) {
michael@0:         $failedContractid_n{$1}++;
michael@0:         next;
michael@0:     }
michael@0: 
michael@0:     # ContractIDToClassID
michael@0:     if (/ContractIDToClassID\((.*)\).*\{(.*)\}/) {
michael@0:         $contractid{$2} = $1;
michael@0:         $contractid_n{$2}++;
michael@0:         next;
michael@0:     }
michael@0: 
michael@0:     # CreateInstance()
michael@0:     if (/CreateInstance\(\{(.*)\}\) succeeded/) {
michael@0:         $objs{$1}++;
michael@0:         next;
michael@0:     }
michael@0: 
michael@0:     # CreateInstanceByContractID()
michael@0:     if (/CreateInstanceByContractID\((.*)\) succeeded/) {
michael@0:         $objs_contractid{$1}++;
michael@0:         next;
michael@0:     }
michael@0: 
michael@0:     # FAILED CreateInstance()
michael@0:     if (/CreateInstance\(\{(.*)\}\) FAILED/) {
michael@0:         $failedObjs{$1}++;
michael@0:         next;
michael@0:     }
michael@0: }
michael@0: 
michael@0: # if there is a file named reg.out in the current dir
michael@0: # then use that to fill in the ContractIDToClassID mapping.
michael@0: my $REG;
michael@0: open REG, "<reg.out";
michael@0: while (<REG>) {
michael@0:     chomp;
michael@0:     if (/contractID -  (.*)$/) {
michael@0:         my $id = $1;
michael@0:         $cid = <REG>;
michael@0:         chomp($cid);
michael@0:         $cid =~ s/^.*\{(.*)\}.*$/$1/;
michael@0:         $contractid{$cid} = $id;
michael@0:     }
michael@0: }
michael@0: 
michael@0: # print results
michael@0: # ----------------------------------------------------------------------
michael@0: 
michael@0: # dlls loaded
michael@0: print "dlls loaded [", scalar @dlls, "]\n";
michael@0: print "----------------------------------------------------------------------\n";
michael@0: for ($n = 0; $n < scalar @dlls; $n++) {
michael@0:     printf "%2d. %s\n", $n+1, $dlls[$n];
michael@0: }
michael@0: print "\n";
michael@0: 
michael@0: # Objects created
michael@0: print "Object creations from CID [", sum(\%objs), "]\n";
michael@0: print "----------------------------------------------------------------------\n";
michael@0: foreach $cid (sort {$objs{$b} <=> $objs{$a} } keys %objs) {
michael@0:     last if (!$all && $objs{$cid} < 50);
michael@0:     printf "%5d. %s - %s\n", $objs{$cid}, $cid, getContractID($cid);
michael@0: }
michael@0: print "\n";
michael@0: 
michael@0: print "Object creations from ContractID [", sum(\%objs_contractid), "]\n";
michael@0: print "----------------------------------------------------------------------\n";
michael@0: foreach $cid (sort {$objs_contractid{$b} <=> $objs_contractid{$a} } keys %objs_contractid) {
michael@0:     last if (!$all && $objs_contractid{$cid} < 50);
michael@0:     printf "%5d. %s - %s\n", $objs_contractid{$cid}, $cid, getContractID($cid);
michael@0: }
michael@0: print "\n";
michael@0: 
michael@0: # FAILED Objects created
michael@0: print "FAILED Objects creations [", sum(\%failedObjs), "]\n";
michael@0: print "----------------------------------------------------------------------\n";
michael@0: foreach $cid (sort {$failedObjs{$b} <=> $failedObjs{$a} } keys %failedObjs) {
michael@0:     last if (!$all && $failedObjs{$cid} < 50);
michael@0:     printf "%5d. %s - %s", $failedObjs{$cid}, $cid, getContractID($cid);
michael@0: }
michael@0: print "\n";
michael@0: 
michael@0: # ContractIDToClassID calls
michael@0: print "ContractIDToClassID() calls [", sum(\%contractid_n),"]\n";
michael@0: print "----------------------------------------------------------------------\n";
michael@0: foreach $cid (sort {$contractid_n{$b} <=> $contractid_n{$a} } keys %contractid_n) {
michael@0:     last if (!$all && $contractid_n{$cid} < 50);
michael@0:     printf "%5d. %s - %s\n", $contractid_n{$cid}, $cid, getContractID($cid);
michael@0: }
michael@0: print "\n";
michael@0: 
michael@0: 
michael@0: # FAILED ContractIDToClassID calls
michael@0: print "FAILED ContractIDToClassID() calls [", sum(\%failedContractid_n), "]\n";
michael@0: print "----------------------------------------------------------------------\n";
michael@0: foreach $cid (sort {$failedContractid_n{$b} <=> $failedContractid_n{$a} } keys %failedContractid_n) {
michael@0:     last if (!$all && $failedContractid_n{$cid} < 50);
michael@0:     printf "%5d. %s\n", $failedContractid_n{$cid}, $cid;
michael@0: }
michael@0: print "\n";
michael@0: 
michael@0: 
michael@0: # Subroutines
michael@0: 
michael@0: sub getContractID($) {
michael@0:     my $cid = shift;
michael@0:     my $ret = "";
michael@0:     $ret = $contractid{$cid} if (exists $contractid{$cid});
michael@0:     return $ret;
michael@0: }
michael@0: 
michael@0: sub sum($) {
michael@0:     my $hash_ref = shift;
michael@0:     my %hash = %$hash_ref;
michael@0:     my $total = 0;
michael@0:     my $key;
michael@0:     foreach $key (keys %hash) {
michael@0:         $total += $hash{$key};
michael@0:     }
michael@0:     return $total;
michael@0: }