Mercurial > pub > Impl
view Lib/IMPL/Profiler/Memory.pm @ 160:3f09584bf189
Corrected web application modules
author | wizard |
---|---|
date | Mon, 27 Dec 2010 19:41:36 +0300 |
parents | 16ada169ca75 |
children | 029c9610528c |
line wrap: on
line source
package IMPL::Profiler::Memory; use strict; use Carp qw(longmess shortmess); use Scalar::Util qw(refaddr weaken isweak); my %instances; BEGIN { *CORE::GLOBAL::bless = sub { $_[1] |= caller unless $_[1]; my $ref = CORE::bless $_[0],$_[1]; my $id = refaddr($ref); $instances{$id} = { Class => $_[1], WeakRef => $ref }; weaken($instances{$id}{WeakRef}); return $ref; } } sub DumpAlive { my ($hout) = @_; $hout = *STDOUT unless $hout; print $hout "Alive objects table\n"; print $hout "-------------------\n"; while (my ($id,$info) = each %instances) { delete $instances{$id} and next unless $info->{WeakRef}; print "$info->{Class} $id: $info->{WeakRef}\n"; } } sub StatClasses { my ($hout) = @_; $hout = *STDOUT unless $hout; print $hout "Statistics by class\n"; print $hout "-------------------\n"; my %stat; while (my ($id,$info) = each %instances) { #$stat{$info->{Class}}{total} ++; delete $instances{$id} and next unless $info->{WeakRef}; $stat{$info->{Class}}{alive} ++; } print $hout "$_ $stat{$_}{alive} \n" foreach sort keys %stat; } sub Clear { undef %instances; } 1;