| Subject: | memory leaks due to _parent link in HTML::Element |
Hi,
Several memory leaks were found in the modules of HTML::Widget package.
See the attached test script which demonstrates 3 different type of leaks.
These leaks are caused by cyclic references formed by '_parent' links of
HTML::Element objects. According to the HTML::Element documentation in
order to prevent memory leaks, any object which uses HTML::Element
should take care of proper destruction.
See the memory-leaks.patch attached which fixes the found memory leaks.
This patch, however, might be incomplete or even wrong, it just fixes
the leaks found in the application I analysed.
Thanks!
| Subject: | memory-leaks.patch |
diff --git a/HTML/Widget/BlockContainer.pm b/HTML/Widget/BlockContainer.pm
index 5d8f5ce..b6ed070 100644
--- a/HTML/Widget/BlockContainer.pm
+++ b/HTML/Widget/BlockContainer.pm
@@ -43,6 +43,23 @@ sub _build_element {
return ($e);
}
+DESTROY {
+ my $self = shift;
+ my @elements = @{ $self->content };
+ push @elements, @{ $self->pre_content } if $self->pre_content;
+ push @elements, @{ $self->post_content } if $self->post_content;
+ for my $e (@elements) {
+ if ($e->can('delete')) {
+ $e->delete();
+ }
+ if ($e->can('element')
+ && $e->element
+ && $e->element->can('delete')) {
+ $e->element->delete();
+ }
+ }
+}
+
=head1 AUTHOR
Michael Gray, C<mjg@cpan.org>
diff --git a/HTML/Widget/Container.pm b/HTML/Widget/Container.pm
index d131ff2..eebd733 100644
--- a/HTML/Widget/Container.pm
+++ b/HTML/Widget/Container.pm
@@ -221,9 +221,9 @@ L</field_xml> is an alias for L</element_xml>.
sub element_xml {
my $self = shift;
- my @e = $self->_build_element;
return join( '',
- map( { $_->as_XML } $self->_build_element( $self->element ) ) )
+ map( { my $xml = $_->as_XML; $_->delete(); $xml; }
+ $self->_build_element( $self->element ) ) )
|| '';
}
@@ -288,6 +288,15 @@ sub javascript_xml {
return $self->javascript_element->as_HTML('<>&');
}
+DESTROY {
+ my $self = shift;
+ if ($self->can('element')
+ && $self->element
+ && $self->element->can('delete')) {
+ $self->element->delete();
+ }
+}
+
=head1 AUTHOR
Sebastian Riedel, C<sri@oook.de>
diff --git a/HTML/Widget/Result.pm b/HTML/Widget/Result.pm
index 25a1eb9..5ed65cb 100644
--- a/HTML/Widget/Result.pm
+++ b/HTML/Widget/Result.pm
@@ -77,7 +77,11 @@ sub as_xml {
{
$c->push_content( $element->as_list ) unless $element->passive;
}
- return $c->as_XML;
+
+ my $xml = $c->as_XML;
+ $c->delete();
+
+ return $xml;
}
=head2 container
| Subject: | htmlw-leak.pl |
#! /usr/bin/env perl
use strict;
use warnings;
use HTML::Widget;
while (1) {
# Create a widget
my $w = HTML::Widget->new('widget')->method('get')->action('/');
# Add a fieldset to contain the elements
my $fs = $w->element( 'Fieldset', 'user' )->legend('User Details');
# Add some elements
$fs->element( 'Textfield', 'age' )->label('Age')->size(3);
$fs->element( 'Textfield', 'name' )->label('Name')->size(60);
$fs->element( 'Select', 'sex' )->options(1 => 'Male', 2 => 'Female'); # leak #1 see the patch to HTML::Widget::BlockContainer
$fs->element( 'Submit', 'ok' )->value('OK');
# Add some constraints
$w->constraint( 'Integer', 'age' )->message('No integer.');
$w->constraint( 'Not_Integer', 'name' )->message('Integer.');
$w->constraint( 'All', 'age', 'name' )->message('Missing value.');
# Process
my $result = $w->process;
for my $i (1..5) {
my $xml = $result->as_xml(); # leak #2 see the patch to HTML::Widget::Result
for my $e ($result->elements) {
my $s = $e->element_xml; # leak #3 see the patch to HTML::Widget::Container
}
}
}