| Subject: | Memory leak if an IPTrie becomes unreferenced |
| Date: | Fri, 20 Aug 2010 15:13:33 +0200 |
| To: | bug-Net-IPTrie [...] rt.cpan.org |
| From: | Christian Ehrhardt <Christian_Ehrhardt [...] genua.de> |
Hi,
the IPTrie structure creates circular references of its node structures
which means that these structures will not get freed if the IPTrie becomes
unreferenced. This causes a memory leak in the following simple perl
script:
| #!/usr/bin/perl
|
| use strict;
| use warnings;
|
| use Net::IPTrie;
|
| my $tr;
|
| while (1) {
| print "ITERATION\n";
| $tr = Net::IPTrie->new(version => 4);
| for (my $i=1; $i<10; $i++) {
| next if ($i == 8);
| $tr->add(address => "$i.$i.0.0/8", prefix => 16);
| }
| $tr->find(address => "1.1.1.1") or die;
| $tr->find(address => "12.12.12.12") and die;
| }
|
| 0;
The proper fix is probably to use Scalar::Util::weaken on the 'up'
field of the node structure. This is somewhat complicated by the fact
that we cannot easily overwrite the up and new methods in the class
generated by Classs::Struct. The following patch against Net::IPTrie::Node
provides a solution that makes the memory leak go away.
regards Christian
--- /usr/share/perl5/Net/IPTrie/Node.pm 2010-05-21 10:29:59.000000000 +0200
+++ Net/IPTrie/Node.pm 2010-08-20 15:00:43.000000000 +0200
@@ -4,6 +4,7 @@
use strict;
use Carp;
use Class::Struct;
+use Scalar::Util qw(weaken);
use vars qw($VERSION);
$VERSION = '0.5';
@@ -21,15 +22,39 @@
=cut
-struct (
-'up' => '$',
-'left' => '$',
-'right' => '$',
-'address' => '$',
-'iaddress' => '$',
-'prefix' => '$',
-'data' => '$',
-);
+BEGIN {
+ struct (
+ "Net::IPTrie::_Node" => {
+ 'up' => '$',
+ 'left' => '$',
+ 'right' => '$',
+ 'address' => '$',
+ 'iaddress' => '$',
+ 'prefix' => '$',
+ 'data' => '$',
+ });
+}
+
+use base qw (Net::IPTrie::_Node);
+
+sub new {
+ my $ret = shift->SUPER::new(@_);
+ if (defined($ret->{'Net::IPTrie::_Node::up'})) {
+ weaken $ret->{'Net::IPTrie::_Node::up'};
+ }
+ return $ret;
+}
+
+sub up {
+ my $self = shift;
+ if (@_) {
+ $self->{'Net::IPTrie::_Node::up'} = shift;
+ if (defined($self->{'Net::IPTrie::_Node::up'})) {
+ weaken $self->{'Net::IPTrie::_Node::up'};
+ }
+ }
+ return $self->{'Net::IPTrie::_Node::up'};
+}
=head1 CLASS METHODS