lib/CWMP/MemLeak.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
package CWMP::MemLeak;

use strict;
use warnings;


use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors( qw/
tracker
generator
debug
/ );

#use Carp qw/confess/;
use Data::Dump qw/dump/;
use Devel::Events::Handler::ObjectTracker;
use Devel::Events::Generator::Objects;
use Devel::Size 'total_size';


=head1 NAME

CWMP::MemLeak - debugging module to detect memory leeks

=head1 METHODS

=head2 new

  my $leek = CWMP::MemLeak->new({
        debug => 1
  });

=cut

sub new {
        my $class = shift;
        my $self = $class->SUPER::new( @_ );

        warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;

        $self->tracker(Devel::Events::Handler::ObjectTracker->new());
        $self->generator(
                Devel::Events::Generator::Objects->new(handler => $self->tracker)
        );
                                            
        $self->generator->enable();

        return $self;
}

=head2 report

  my $size = $leek->report;

=cut

my $empty_array = total_size([]);

sub report {
        my $self = shift;

        $self->generator->disable();

        my $leaked = $self->tracker->live_objects;
        my @leaks = keys %$leaked;

        my $size = total_size([ @leaks ]) - $empty_array;

        warn "leaked $size = ",dump( $leaked ),$/ if $size > 2;


        $self->generator(undef);
        $self->tracker(undef);

        return $size;
}

1;
1	# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
2	package CWMP::MemLeak;
3
4	use strict;
5	use warnings;
6
7
8	use base qw/Class::Accessor/;
9	__PACKAGE__->mk_accessors( qw/
10	tracker
11	generator
12	debug
13	/ );
14
15	#use Carp qw/confess/;
16	use Data::Dump qw/dump/;
17	use Devel::Events::Handler::ObjectTracker;
18	use Devel::Events::Generator::Objects;
19	use Devel::Size 'total_size';
20
21
22	=head1 NAME
23
24	CWMP::MemLeak - debugging module to detect memory leeks
25
26	=head1 METHODS
27
28	=head2 new
29
30	my $leek = CWMP::MemLeak->new({
31	debug => 1
32	});
33
34	=cut
35
36	sub new {
37	my $class = shift;
38	my $self = $class->SUPER::new( @_ );
39
40	warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
41
42	$self->tracker(Devel::Events::Handler::ObjectTracker->new());
43	$self->generator(
44	Devel::Events::Generator::Objects->new(handler => $self->tracker)
45	);
46
47	$self->generator->enable();
48
49	return $self;
50	}
51
52	=head2 report
53
54	my $size = $leek->report;
55
56	=cut
57
58	my $empty_array = total_size([]);
59
60	sub report {
61	my $self = shift;
62
63	$self->generator->disable();
64
65	my $leaked = $self->tracker->live_objects;
66	my @leaks = keys %$leaked;
67
68	my $size = total_size([ @leaks ]) - $empty_array;
69
70	warn "leaked $size = ",dump( $leaked ),$/ if $size > 2;
71
72
73	$self->generator(undef);
74	$self->tracker(undef);
75
76	return $size;
77	}
78
79	1;