Skip Menu |
 

This queue is for tickets about the Tk CPAN distribution.

Report information
The Basics
Id: 29640
Status: open
Priority: 0/
Queue: Tk

People
Owner: Nobody in particular
Requestors: J.Steinblock [...] kesseboehmer.de
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



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>
Download (untitled) / with headers
text/plain 2.9k
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 ************************************************
Download (untitled) / with headers
text/html 35.5k

Message body is not shown because it is too large.

Download (untitled) / with headers
text/plain 1.8k
On Thu Sep 27 05:35:08 2007, J.Steinblock@kesseboehmer.de wrote: Show quoted text
> 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. >
Confirmed. It seems that the SV with the raw base64 data is stored somewhere in the Perl/Tk interna and never freed. It also does not help not using the base64 encoded data, but raw gif data using the new Tk804.027_50x. The only workaround for now seems to be the usage of temporary files. Maybe it could also help to use the data() method of Tk::Photo. Regards, Slaven


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.