Subject: | Memory Issus with TK::Photo and -data option |
Date: | Thu, 27 Sep 2007 11:32:00 +0200 |
To: | <bug-Tk [...] rt.cpan.org> |
From: | "Steinblock, Juergen" <J.Steinblock [...] kesseboehmer.de> |
Hello,
I think I found a bug in TK::Photo and at http://rt.cpan.org/Public/Bug/Report.html?Queue=Tk bug reports could be send to this mail-adress.
I tried to write a TK app that show´s a slideshow of images.
Now I noticed that the memory usage increases about 1 mb every time I swap the images and tracked down the problem to TK::Photo with the "-data" option. All my efforts to free the memory didn´t work.
System:
- Windows XP SP2
- Perl 5.8.8
- TK 804.27.0.5
Error:
If I create a Photo Object with
$img = $mw->Photo( 'image', -file => $imgfile)
there is no memory leak.
But if I use this code
---------------------------
use GD::Image;
use MIME::Base64;
my %image_data;
...
$img = $mw->Photo( 'image', -data => encode_base64(resize_image($imgfile, 1024, 768)));
sub resize_image {
my $file = shift; my $x = shift; my $y = shift;
if(defined($image_data{$file})) { return($image_data{$file})}
my $image = GD::Image->new($file);
my $image_resized = GD::Image->new($x, $y);
$image_resized->copyResampled($image,0,0,0,0,$x,$y,$image->width,$image->height);
$image_data{$file} = $image_resized->gif();
return($image_data{$file});
}
-------------------------
the memory increases.
The function resize_image has no leak, it´s stores every image in an hash-element, but I have only 10 images to swap and after the first full cycle no additional memory is used.
Mit freundlichen Grüßen
Jürgen Steinblock
Systemadministrator
Heinrich J. Kesseböhmer KG
Mindener Str. 208
49152 Bad Essen
Deutschland
Telefon: +49 (5742) 46-1462
Fax: +49 (5742) 4661462
E-Mail: mailto:j.steinblock@kesseboehmer.de
Internet: www.kesseboehmer.de
Here is a fully working example that doesn´t show the images in the TK-Window but reproduces the bug:
use Tk;
use GD::Image;
use MIME::Base64;
my %image_data;
my @images = ("0051520000_01.gif", "0051520000_02.gif", "0051520000_03.gif");
my $images_path = "c:/temp/visu/";
my $images_count = 0;
my $mw = new MainWindow;
#~ my $imagit = $mw
#~ ->Label
#~ ->pack( -expand => 1, -fill => 'both', );
#~ my $img2;
$mw->bind( '<Left>' => \&prev_image );
$mw->bind( '<Right>' => \&next_image );
MainLoop;
sub next_image {
my $img = $mw->Photo( 'image', -data => encode_base64(resize_image($images_path . $images[$images_count], 1024, 768)));
if($images_count == 2) { $images_count = 0 }
else {$images_count++}
}
sub resize_image {
my $file = shift; my $x = shift; my $y = shift;
if(defined($image_data{$file})) { return($image_data{$file})}
my $image = GD::Image->new($file);
my $image_resized = GD::Image->new($x, $y);
$image_resized->copyResampled($image,0,0,0,0,$x,$y,$image->width,$image->height);
$image_data{$file} = $image_resized->gif();
return($image_data{$file});
}
************************************************
Heinrich J. Kesseböhmer KG
Mindener Str. 208
D-49152 Bad Essen
HR A 4013 Amtsgericht Osnabrück
USt-IdNr. DE206585880
Komplementär: Heinrich J. Kesseböhmer
************************************************
Message body is not shown because it is too large.