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;