1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
#! perl
my $laststamp = 0;
my @callstack;
my @calltime;
my %stats;
while (<>) {
my ($eventstamp, $loc, $event, $routine) = split ' ', $_;
next unless ($event =~ /START|PROTO|PASS|FAIL/);
$routine = '<anon>' if ($routine eq '' || $routine eq 'at');
my $elapsed = $eventstamp - $laststamp;
$laststamp = $eventstamp;
if (@callstack) { $calltime[-1] += $elapsed; }
if ($event eq 'START' || $event eq 'PROTO') {
$stats{$routine}{'callcount'}++;
push @callstack, $routine;
push @calltime, 0;
next;
}
if ($callstack[-1] ne $routine) {
die "malformed trace: $routine vs @callstack";
}
else { pop @callstack; }
if ($event eq 'PASS') {
$stats{$routine}{'passcount'}++;
$stats{$routine}{'passtime'} += pop @calltime;
}
if ($event eq 'FAIL') {
$stats{$routine}{'failcount'}++;
$stats{$routine}{'failtime'} += pop @calltime;
}
}
foreach my $r (keys %stats) {
$stats{$r}{'calltime'} = $stats{$r}{'passtime'} + $stats{$r}{'failtime'};
foreach (qw( callcount calltime passcount passtime failcount failtime )) {
$stats{'TOTAL'}{$_} += $stats{$r}{$_};
}
}
my @keys = sort { $stats{$b}{'calltime'} <=> $stats{$a}{'calltime'} }
keys %stats;
print " All Passing Failing \n";
print "Regex Calls Time Calls Time Calls Time \n";
print "--------------------------------------------------------------------------------------\n";
foreach my $r (@keys) {
printf "%-40s: %5d %8.4f %5d %8.4f %5d %8.4f\n",
$r,
$stats{$r}{'callcount'}, $stats{$r}{'calltime'},
$stats{$r}{'passcount'}, $stats{$r}{'passtime'},
$stats{$r}{'failcount'}, $stats{$r}{'failtime'};
}
|
