--- a/Lib/IMPL/Profiler/Memory.pm	Tue Apr 03 07:54:25 2012 +0400
+++ b/Lib/IMPL/Profiler/Memory.pm	Tue Apr 03 20:08:42 2012 +0400
@@ -4,54 +4,106 @@
 use Carp qw(longmess shortmess);
 use Scalar::Util qw(refaddr weaken isweak);
 
-my %instances;
+my %listeners;
+my $trapped;
 
 BEGIN {
-    *CORE::GLOBAL::bless = sub {
-        $_[1] |= caller unless $_[1];
-        my $ref = CORE::bless $_[0],$_[1];
+	$trapped = 0;
+}
 
-        my $id = refaddr($ref);
+sub import {
+	if (not $trapped) {
+	    *CORE::GLOBAL::bless = sub {
+	        $_[1] |= caller unless $_[1];
+	        my $ref = CORE::bless $_[0],$_[1];
+	
+	        $_->track($ref) foreach values %listeners;
+	
+	        return $ref;
+	    };
+	    $trapped = 1;
+	}
+}
 
-        $instances{$id} = {
-            Class => $_[1],
-            WeakRef => $ref
-        };
+sub _ConnectListener {
+	my ($self,$listener) = @_;
+	
+	die "Invalid listener" unless ref $listener;
+	
+	$listeners{refaddr($listener)} = $listener;
+}
 
-        weaken($instances{$id}{WeakRef});
+sub _RemoveListener {
+	my ($self,$listener) = @_;
+	
+	die "Invalid listener" unless ref $listener;
+	
+	delete $listeners{refaddr($listener)};
+}
 
-        return $ref;
-    }
+sub Monitor {
+	my ($self,$code) = @_;
+	
+	my $data = IMPL::Profiler::Memory::Data->new();
+	
+	$data->Monitor($code);
+	
+	return $data; 
 }
 
-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";
-    }
+package IMPL::Profiler::Memory::Data;
+use parent qw(IMPL::Object::Fields);
+
+use Data::Dumper();
+use Scalar::Util qw(refaddr weaken isweak);
+
+use fields qw( objects );
+
+sub CTOR {
+	my $this = shift;
+	$this->{objects} = [];
+}
+
+sub track {
+	my $i = scalar @{$_[0]->{objects}};
+	$_[0]->{objects}[$i] = $_[1];
+	weaken($_[0]->{objects}[$i]);
+}
+
+sub Purge {
+	my $this = shift;
+	
+	return $this->{objects} = [ grep defined($_), @{$this->{objects}}];
 }
 
-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} ++;
-    }
+sub Dump {
+	my $this = shift;
+	return Data::Dumper->Dump($this->{objects});
+}
 
-    print $hout "$_ $stat{$_}{alive} \n" foreach sort keys %stat;
+sub isLeak {
+	my ($this) = @_;
+	$this->Purge();
+	return ( scalar(@{$this->{objects}}) > 0);
 }
 
-sub Clear {
-    undef %instances;
+sub Monitor {
+	my ($this,$code) = @_;
+	
+	die "A reference to a subroutine is required" unless ref $code;
+	
+	IMPL::Profiler::Memory->_ConnectListener($this);
+	eval {
+		$code->();
+	};
+	my $err = $@;
+	IMPL::Profiler::Memory->_RemoveListener($this);
+	
+	die $err if $err;
+	
+	return;
 }
 
+
+
 1;