Mercurial > pub > Impl

comparison Lib/IMPL/Profiler/Memory.pm @ 0:03e58a454b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
1 package IMPL::Profiler::Memory;
2
3 use strict;
4 use Carp qw(longmess shortmess);
5 use Scalar::Util qw(refaddr weaken isweak);
6
7 my %instances;
8
9 BEGIN {
10 *CORE::GLOBAL::bless = sub {
11 $_[1] |= caller unless $_[1];
12 my $ref = CORE::bless $_[0],$_[1];
13
14 my $id = refaddr($ref);
15
16 $instances{$id} = {
17 Class => $_[1],
18 WeakRef => $ref
19 };
20
21 weaken($instances{$id}{WeakRef});
22
23 return $ref;
24 }
25 }
26
27 sub DumpAlive {
28 my ($hout) = @_;
29 $hout = *STDOUT unless $hout;
30 print $hout "Alive objects table\n";
31 print $hout "-------------------\n";
32 while (my ($id,$info) = each %instances) {
33 delete $instances{$id} and next unless $info->{WeakRef};
34 print "$info->{Class} $id: $info->{WeakRef}\n";
35 }
36 }
37
38 sub StatClasses {
39 my ($hout) = @_;
40 $hout = *STDOUT unless $hout;
41 print $hout "Statistics by class\n";
42 print $hout "-------------------\n";
43 my %stat;
44 while (my ($id,$info) = each %instances) {
45 #$stat{$info->{Class}}{total} ++;
46 delete $instances{$id} and next unless $info->{WeakRef};
47 $stat{$info->{Class}}{alive} ++;
48 }
49
50 print $hout "$_ $stat{$_}{alive} \n" foreach sort keys %stat;
51 }
52
53 sub Clear {
54 undef %instances;
55 }
56
57 1;