in reply to Tk::Image delete method

Perl/Tk associates images with their corresponding MainWindow objects. Since you are only handling a single window at a time and repeatedly entering Tk's MainLoop, Tk is destroying the Image handles when it cleans up the MainWindow and shuts down. Run the program for a while and see if it leaks memory — I suspect that it does not.

This is not the normal way to use Tk in Perl — you actually do not have a single callback anywhere in the program and are not fully using Tk's MainLoop, which should normally be the last step of the main script's execution.

#!/usr/bin/perl

use strict;
use warnings;

use Tk;

# ... setup code that prepares the widget hierarchy ...

MainLoop;

# ... cleanup code as the program is exiting, usually there is nothing
+ here ...

__END__

[download]

Replies are listed 'Best First'.
Re^2: Tk::Image delete method
by Anonymous Monk on Dec 18, 2019 at 03:10 UTC
    Thanks for the example. It made me realize that the while loop is somehow causing the memory of the process to grow by the size of each image. In this version the memory grows and shrinks according to the image size, with no need for delete: 
    #!/usr/bin/perl

=head1 DESCRIPTION

View random images from the supplied folder (supports . and ~).
Every time you close an image a new random image will open,
until the program is stopped.

Inspired by "Re^2: Tk show image from web" by IB2017
https://www.perlmonks.org/index.pl?node_id=11108799

=cut

use strict;
use warnings;
use autodie;

use Encode;
use File::Spec;
use MIME::Base64;

use Image::Info;
use Imager;

use Tk;
use Tk::Photo;
use Tk::JPEG;
use Tk::PNG;

my $dir = shift ||
die "Usage: $0 /path/to/images";
die 'Folder not found :-(' unless -d $dir;

my $img = shift; # an initial image, for debugging

opendir my $dh, glob $dir;
my @img = grep /\.(jpe?g|gif|png|bmp)/i, readdir $dh;
closedir $dh;

die 'No images found, try again!' unless @img;

my $file = $img || $img[rand@img];
my $path = File::Spec->catfile($dir,$file);

if (Image::Info::image_type($path)->{file_type} eq 'JPEG') {
    
  my $info = Image::Info::image_info($path);
    
  if ($info->{color_type} eq 'CMYK') {
    
    my $tmpdir = File::Spec->tmpdir;
    my $imager = Imager->new;
    
    $imager->read(file=>$path)
    or die $imager->errstr;
    
    $path = File::Spec->catfile($tmpdir,$file);
    
    # Converts CMYK to RGB
    $imager->write(file=>$path)
    or die $imager->errstr
  }
}
open my $fh, '<', $path;
my $data = join '', <$fh>;
close $fh;

$data = MIME::Base64::encode_base64($data);

my $mw = MainWindow->new;
   $mw->configure(-title => Encode::decode_utf8($file));

my $top   = $mw->Frame()->pack();
my $image = $mw->Photo(-data => $data);
my $label = $top->Label(-image => $image)->pack();

print $path, "\n", $image->width, 'x', $image->height, "\n\n";

MainLoop;

exec 'perl', $0, $dir;

    [download]
[reply]
[d/l]

      Could it be because you *re-load* perl and your script every time via that exec? btw how does user exit such a cycle? Or is it meant to be a virus? (re: cookie cookie i need a cookie now)

[reply]
[d/l]

        You may laugh, but I have written a Perl/Tk program (that persists its state on disk) using Tk::Table and ended up adding a menu item that does exec $0 upon user command because I found that it gets strangely slow after some amount of usage. That program is just a small "toy" for my personal use and an exercise in using Tk, so restarting it when it gets slow works well enough for me and the "simple hack" was far easier than tracking down exactly what is going wrong.

[reply]
[d/l]
[select]
        Could it be because you *re-load* perl and your script every time via that exec?

        Why not? It's simple and does what I want. I'm not getting any help making it work "correctly" therefore I hack until it does what I mean.

        btw how does user exit such a cycle?

        Same way it was started, in the console, with ctrl+c.

        Or is it meant to be a virus?

        How is it a virus? It's meant to be fun and productive. I have so many images and so little time to enjoy them. I love this program!

[reply]

In Section Seekers of Perl Wisdom