Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re: Hunting for a memory leak

by zentara (Archbishop)
on Aug 07, 2012 at 18:34 UTC ( #986054=note: print w/ replies, xml ) Need Help??


in reply to Hunting for a memory leak

Reuse Photo objects, by blanking them and loading another image. Also you may want to reuse your toplevel window too. See Re: Tk::Gauge errors. Undef'ing them in a subroutine closure will not always work.

Toplevels and Photo objects leak memory, and need to be reused, instead of a create/destroy cycle, when called often in a script. See Re^2: Tk and ImageMagick


I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh


Comment on Re: Hunting for a memory leak
Re^2: Hunting for a memory leak
by perldough (Sexton) on Aug 08, 2012 at 14:32 UTC

    This solved it: no more memory leaks at all.

    Here is my modified code for posteriority:

    use Tk; use Tk; use Tk::PNG; use Tk::LabFrame; use Tk::Radiobutton; use Tk::Pane; use Tk::WorldCanvas; use strict; use feature 'state'; our $currdwg = "./largeimage.png"; our $ZC; our $sr; our ($imgX, $imgY); our $MW = MainWindow->new(-title => " PROXY FOR MW"); $MW->geometry("+4+5"); review($MW); MainLoop; sub review { my ($MW) = @_; my ($RW, $CW) = makeReviewScreen($MW); } sub makeReviewScreen { my ($MW) = @_; our $width = $MW->screenwidth - 145; my $RW = $MW->Toplevel(-title => 'XXX'); $RW->geometry("+0+5"); my $LW = $RW->Frame; my $CW = $RW->Scrolled('WorldCanvas', -width => $width, -height => '480', -background => 'white', -borderwidth => '3', -scrollbars => 'se', -relief => 'sunken', -scrollregion => [-100,0, 6000,40 +00]); $ZC = new ZoomCanvas($CW, 1); $LW->pack(-side => 'left', -fill => 'y', -expand => '1', -ancho +r => 'nw', ); $CW->pack(-side => 'left', -fill => 'both', -expand => '1' ); $RW->bind('<Up>' => sub { print "start\n"; start_problems($MW, $ZC); print "end\n"; } ); print "init start\n"; start_problems($MW, $ZC); print "init end\n"; return ( $RW, $CW); } sub start_problems { my ($MW, $ZC) = @_; my @items = $ZC->find('all'); for my $item (@items) { $ZC->delete($item); } show_drawing($MW, $ZC); } sub show_drawing { use GD::Image; use MIME::Base64 qw[ encode_base64 ]; my ($MW, $ZC) = @_; #----------------- Display drawing at specified +- zoom --------- +---------# my $orig = GD::Image->new($currdwg); my ($xMax, $yMax) = $orig->getBounds; $sr = 3500/ $xMax; ($imgX, $imgY) = map { int($_ * $sr) } $orig->getBounds; my $small = GD::Image->new($imgX, $imgY); $small->copyResampled($orig, 0, 0, 0, 0, $imgX, $imgY, $orig->getB +ounds); # Make sure $img doesn't get released. # Only define new object the first time around. state $img; if (! defined $img) { $img = $MW->Photo(); } # Modify existing object. $img->configure("-format", "png"); $img->configure("-data", encode_base64( $small->png )); # Don't define new object every time. #my $img = $Tk->{MW}->Photo(-data => encode_base64( $small->png ), # -format => 'png' # ); $MW->configure( -title => " REVIEW INTERLOCKING DRAWING - $currd +wg ($xMax x $yMax)"); my $dwg = $ZC->createImage($MW,0,0, -anchor => 'nw', -image => $im +g, -tags => 'dwg'); $ZC->centerTags($dwg); undef $small; undef $orig; # Don't delete $img; keep it for next time. #undef $img; return ([$xMax, $yMax],[$imgX, $imgY]); } package ZoomCanvas; use strict; use Tk; use feature 'state'; sub new { my $class = shift; my $canvas = shift; my $zoom = shift; # Quick loose check to ensure $canvas is a WorldCanvas my $test1 = (ref($canvas) eq "Tk::Frame"); use Data::Dumper; my $test2 = (Dumper($canvas) =~ "worldcanvas"); if (! ($test1 && $test2)) { die "ZoomCanvas::new: canvas argument not WorldCanvas!\n" } if (! defined $zoom) { $zoom =1; } my $self = { CANVAS => $canvas, ZOOM => $zoom }; bless $self, $class; return $self; } sub AUTOLOAD { my @args = @_; my $self = shift @args; my $substring = $ZoomCanvas::AUTOLOAD; my @splitSub = split("::", $substring); my $sub = $splitSub[1]; my $canvas = $self->{CANVAS}; return $canvas->$sub(@args); } sub createImage { use Tk::Photo; use Storable; use Storable qw(nstore dclone); # Create state vars state $xoff; state $yoff; state %miscArgs; state $MW; my @args = @_; my $self = shift @args; my $canvas = $self->{CANVAS}; my $MW_tmp = shift @args; # Original args my $xoff_tmp = shift @args; my $yoff_tmp = shift @args; my %miscArgs_tmp = @args; if ( defined $MW_tmp && defined $xoff_tmp && defined $yoff_tmp && (keys %miscArgs_tmp) ) { $MW = $MW_tmp; $xoff = $xoff_tmp; $yoff = $yoff_tmp; if (exists $miscArgs{-image}) { delete $miscArgs{-image}; } %miscArgs = %miscArgs_tmp; } my $img = $miscArgs{-image}; # Make sure $zimg doesn't get released # Only define new object the first time around state $zimg; if (! defined $zimg) { $zimg = $MW->Photo(); } #my $zimg = $MW->Photo(); ($self->{ZOOM} > 1) ? $zimg->copy($img, -zoom => $self->{ZOOM +}) : $zimg->copy($img, -subsample => (1 / $self-> +{ZOOM})); $miscArgs{-image} = $zimg; my @miscArgs_list = %miscArgs; my $return = $canvas->createImage($xoff,$yoff, @miscArgs_list); $miscArgs{-image} = $img; delete $miscArgs{-image}; delete $miscArgs_tmp{-image}; # Don't delete; keep them for later #undef $img; #undef $zimg; return $return; } 1;
    Thanks everyone,
    Perldough
      That's a nice use of state to avoid the global variable. :-)
      # Make sure $img doesn't get released. # Only define new object the first time around. state $img; if (! defined $img) { $img = $MW->Photo(); }

      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://986054]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (14)
As of 2014-10-31 19:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (223 votes), past polls