Losing my memory

[nzsvz9]

All,

I have 2 perl Tk applications which bring in images (png, gif, jpg) and display them in a popup window, doing fun things with them, then when the user closes the popup window, the user goes on to do more work on another image in another popup window. Problem is the perl interpreter is taking up more and more memory with every image and never releases it, until it runs out of memory.

In the programs I have a hash called %TK in which I keep track of TK objects.I create a new unique key for each image the user wants to interact with, which when they select the image I then create a popup window, add a canvas into the popup, then add the image onto the canvas. Simple enough as shown in the code segments below.

  # Create a TK object hash
  our %TK;

  # Generate a key
  $NVP{'Id'}=&newkey({'Join'=>''});
   

  # Create the popupwindow
  $TK{'pw-'.$NVP{'Id'}}=$TK{'mw'}->Toplevel('-title' => $NVP{'Title'})
+;

...

  # Create the main canvas
  $TK{'canvas-'.$NVP{'Id'}}=$TK{'pw-'.$NVP{'Id'}}->Canvas(-background 
+=> $NVP{'Background'},
                                                          -bd         
+=> 1,
                                                          -relief     
+=> 'sunken')->pack(-fill   => 'both',
                                                                      
+                   -anchor => 'center',
                                                                      
+                   -expand => 1);

...

  # Create an image
  $TK{'image-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo($imagename
+,
                                                            -file   =>
+ $NVP{'File'},
                                                            -format =>
+ $extension);

I apologize for the horrible coding style I use ... but I digress.

And the memory used by the program grows if I delete everything from the canvas by invoking $TK{'canvas-'.$NVP{'Id'}}->delete("all"); and still grows with each new image if I invoke $TK{'image-'.$NVP{'Id'}}->destroy(); and even continues to grow with each new image if I use $TK{'pw-'.$NVP{'Id'}}->destroy(); on the popup window.

The programs work great otherwise until they run out of memory ...

Any ideas?

I thank you in advance.

[Discipulus]

Hello nzsvz9

> is taking up more and more memory with every image and never releases it

yes Tk when dealing with images indeed leaks memory! I had the very same problem with Tk::Photo

The trick is to reuse every object as much as possible, using undef against variables containing data using delete where it applies and, in my case, using a dummy empty file in $phwin->Photo(-file => "" )

In my picwoodpecker program I load many big pictures and finally got it not leaking memory. See the setup_draw_area sub to see it in action (search the program for various $tk_ph_image->delete if $tk_ph_image->blank and similar calls).

I asked a very similar question to your one when I noticed the leak: you can find it an interesting read and a possible starting point: Tk photo display: memory never released where the last post of the thread show my attempt to debug with a trivial attempt to show memory usage too. The code is full of comments and links useful to solve your problem.

Interesting part of the above perlmonks post:

   # http://search.cpan.org/~srezic/Tk-804.033/pod/Image.pod
   # It's necessary to use the "delete" method to delete an image obje
+ct and
   # free memory associated with it. Just using a lexical variable for
+ storing
   # the image object and letting the variable to go out of scope or s
+etting to
   # undef is not sufficient.
   #
   # $tk_ph_image is a Tk::Photo object
   $tk_ph_image->delete if $tk_ph_image->blank;

Please share your findings ;)

L*

[Fletch]

Not sure but from your description what's happening is even though you're calling the destroy method on the Tk widgets you're not removing the references to those widgets from your hash %TK so the underlying resources those are using aren't going away. I'd bet if you also did e.g. undef $TK{'pw-'.$NVP{'Id'}} after calling destroy you'd see things clean up much more completely.

[nzsvz9]

Thanks- I'll try.

It's handy to keep track of all those pesky Tk things, but if the HASH is causing the problem by "holding on" then I'll have to refactor the way I do my Perl Tk programs ... ugh. MAJOR rewrite.

And cake whispers untruths ...

[eyepopslikeamosquito]

This sort of question comes up often enough that I keep a list of general references at: Re: Perl Memory problem ... (Memory Tools References)

[kcott]

G'day nzsvz9,

This was something that interested me because I write a lot of Tk programs for personal use, and many of them involve images. I've never run out of memory — possibly because I've got lots to start with; 32GB on my current machine — so it has never occurred to me to check for memory leaks.

Your idea of passing around Tk-related data in a hash is, at least in my opinion, a good one. I do it myself and, in the code below, I've provided some basic examples of my type of usage. I do not, however, use package variables; furthermore, my lexical $TK is hidden from almost all of the code in an anonymous block.

You also need to manage your %TK. You didn't show any working code nor give any idea of how many images you're dealing with or how big they are; however, I suspect this is, at least part of, your memory problem. There may well be all sorts of other data you're carrying around well past its use-by-date.

The following code I ran twice. First without, then with, these two lines of code (they're almost at the end of the script):

        (delete $TK->{img}{$name})->delete();
        $TK->{gui}{can}->delete('all');

The first run chewed up about 200MB which was immediately reclaimed when I used the "Exit" button. The second run used no appreciable amount of memory; system memory was unchanged after hitting "Exit".

I can't fix your code because you didn't show it. I attempted to keep most of what you outlined in your description. Hopefully, you can get some ideas from what follows to make improvements.

#!/usr/bin/env perl

use strict;
use warnings;

use Tk;

{
    my $TK = {};
    $TK->{gui}{mw} = MainWindow::->new();
    _build_gui($TK);

    my ($iter, $id) = (0);
    $id = $TK->{gui}{mw}->repeat(500, sub {
        $TK->{gui}{start}->invoke();
        $TK->{gui}{mw}->after(200, sub {
            (shift @{$TK->{gui}{quits}})->invoke();
        });
        $id->cancel if $iter++ > 1_000;
    });
}

MainLoop;

sub _build_gui {
    my ($TK) = @_;

    $TK->{gui}{mw}->configure(-title => 'Test Tk::Photo Memory Leak');
    $TK->{gui}{mw}->geometry('384x216+100+150');
    _build_controls($TK);

    return;
}

sub _build_controls {
    my ($TK) = @_;

    $TK->{gui}{frame} =  $TK->{gui}{mw}->Frame()->pack();

    $TK->{gui}{start} = $TK->{gui}{frame}->Button(
        -text => 'Start', -command => sub { _popup($TK) }
    )->pack();

    $TK->{gui}{frame}->Button(
        -text => 'Exit', -command => sub { exit }
    )->pack();

    return;
}

sub _popup {
    my ($TK) = @_;

    $TK->{img}{id} = 0 unless exists $TK->{img}{id};
    my ($w, $h) = (400, 300);

    $TK->{gui}{top} = $TK->{gui}{frame}->Toplevel();
    $TK->{gui}{top}->geometry("${w}x$h+500+550");
    $TK->{gui}{top}->overrideredirect(1);
    push @{$TK->{gui}{quits}}, $TK->{gui}{top}->Button(-text => 'Quit'
    )->pack(-side => 'bottom');
    $TK->{gui}{can} = $TK->{gui}{top}->Canvas(
    )->pack(-anchor => 'center', -fill => 'both', -expand => 1);
    my $name = 'earth' . $TK->{img}{id}++;
    $TK->{img}{$name} = $TK->{gui}{top}->Photo(
        $name, -file => Tk->findINC('demos/images/earth.gif')
    );
    $TK->{gui}{can}->createImage(
        $w/2, $h/2, -image => $name, -anchor => 'center'
    );

    $TK->{gui}{quits}[-1]->configure(-command => sub {
        (delete $TK->{img}{$name})->delete();
        $TK->{gui}{can}->delete('all');
        $TK->{gui}{top}->destroy();
    });

    return;
}

You should be able to run that without needing to change anything (except maybe the shebang line). The code itself will run on v5.8 (probably even older versions). The image, earth.gif, comes with Tk (it's used in the Widget Demo) so you should already have that.

[nzsvz9]

Thanks Ken. I've run your test code - thanks, and I'm trying to figure out the differences to apply to my own. When I monitor memory usage with task manager - it does not blow up like my own code, so I reviewing.

The reason I didn't include my whole code is because I have a large series of subroutines which I use that are pulled in with requires, so the main code won't run without them. Plus at the bottom of the code I put the test routine - so I can recode, save, then run to test. This works for me but YMMV.

And the $PB stuff at the beginning let's me pull this code into another program, then when I run the main program -v I get a list of all included subroutines at versions.

In the code, the popout section makes a new popup window if a canvas isn't specified in the incoming name/value pairs (%NVP).

I'm also suspecting that the resizable code is partially to blame. The memory blows up at this function. I tied a redraw to the configure event - and when I drag the corner the resized image works, but the constant redrawing chews up memory.

# PB:-----------------------------------------------------------------
+-------
#
$PB{'tk_canvasImage.pl'}{'Author'}     ="Thomas M.P. Catsburg";
$PB{'tk_canvasImage.pl'}{'Class'}      ="subroutine";
$PB{'tk_canvasImage.pl'}{'Date'}       ="19Jun2018";
$PB{'tk_canvasImage.pl'}{'Description'}="Given a configuration - add a
+n image to a given canvas or use a popup canvas - resize if needed to
+ fit given or actual size";
$PB{'tk_canvasImage.pl'}{'Filename'}   ="tk_canvasImage.pl";
$PB{'tk_canvasImage.pl'}{'Version'}    ="1.0";
#
#  1.0  17Jun2019  Initial writing
#

sub tk_canvasImage
{
  # Get the incoming parameters
  my %NVP=&nvp(@_);


  #-------------------------------------------------------------------
+--------

  ### #####
   #  #    #
   #  #    #
   #  #    #
   #  #    #
  ### #####

  # If not given a key
  if(! defined $NVP{'Id'})
  {
    # Generate a key
    $NVP{'Id'}=&newkey({'Join'=>''});
  }


  #-------------------------------------------------------------------
+--------

   ####    ##   #    # #    #   ##    ####
  #    #  #  #  ##   # #    #  #  #  #
  #      #    # # #  # #    # #    #  ####
  #      ###### #  # # #    # ######      #
  #    # #    # #   ##  #  #  #    # #    #
   ####  #    # #    #   ##   #    #  ####

  # Set a default canvas width
  my $cw=200;

  # Set a default canvas height
  my $ch=200;

  # Need to look for config{'canvas'} and make that the tk{'canvas'} o
+therwise do the popup thing
  if(Tk::Exists($NVP{'Canvas'}))
  {
    # Make the current canvas the given canvas
    $TK{'canvas-'.$NVP{'Id'}}=$NVP{'Canvas'};

    # Update the main window so the canvas sizes
    $TK{'mw'}->update();

    # Get the canvas width
    $cw=$TK{'canvas-'.$NVP{'Id'}}->width();

    # Get the canvas height
    $ch=$TK{'canvas-'.$NVP{'Id'}}->height();
  }
  else
  {
    # Create the popupwindow
    $TK{'pw-'.$NVP{'Id'}}=$TK{'mw'}->Toplevel('-title' => $NVP{'Title'
+});

    # Create a geometry string for the popup
    my $geometry=$NVP{'Width'} . 'x' . $NVP{'Height'};

    # Size the popupwindow
    $TK{'pw-'.$NVP{'Id'}}->geometry($geometry);

    # Set the maximum size for the popup
    $TK{'pw-'.$NVP{'Id'}}->maxsize($NVP{'Width'}, $NVP{'Height'}) if($
+NVP{'Maxsize'} =~ /yes|true|1|on/i);

    # Set the minimum size for the popup
    $TK{'pw-'.$NVP{'Id'}}->minsize($NVP{'Width'}, $NVP{'Height'}) if($
+NVP{'Minsize'} =~ /yes|true|1|on/i);

    # Add main window icon if icon is defined
    if($TK{'icon'})
    {
      # Have no idea what this does but the logo does not work without
+ it
      $TK{'pw-'.$NVP{'Id'}}->idletasks;

      # Change the Tk window and idle icon to the supplied image
      $TK{'pw-'.$NVP{'Id'}}->iconimage($TK{'icon'});
    }

    # Configure the popup window with the new title
    $TK{'pw-'.$NVP{'Id'}}->configure('-title' => $NVP{'Title'});

    # Create the main canvas
    $TK{'canvas-'.$NVP{'Id'}}=$TK{'pw-'.$NVP{'Id'}}->Canvas(-backgroun
+d => $NVP{'Background'},
                                                            -bd       
+  => 1,
                                                            -relief   
+  => 'sunken')->pack(-fill   => 'both',
                                                                      
+                     -anchor => 'center',
                                                                      
+                     -expand => 1);

    # Set the canvas width
    $cw=$NVP{'Width'};

    # Set the canvas height
    $ch=$NVP{'Height'};
  }


  #-------------------------------------------------------------------
+--------

  #####   ####  #####   ####  #    # #####
  #    # #    # #    # #    # #    #   #
  #    # #    # #    # #    # #    #   #
  #####  #    # #####  #    # #    #   #
  #      #    # #      #    # #    #   #
  #       ####  #       ####   ####    #

  # If popout button is true
  if($NVP{'Popout'} =~ /yes|true|^1$|on/i)
  {
    # If bitmappopoutnw does not exist
    if($TK{'bitmappopoutnw'} eq '')
    {
      # Create an xbm bitmap
      my $xbmbits = pack("b9" x 9,
                         ".........",
                         ".11111111",
                         ".1.......",
                         ".1.1111..",
                         ".1.11....",
                         ".1.1.1...",
                         ".1.1..1..",
                         ".1.....1.",
                         ".........");

      # Pack xbmbits into a popout arrow bitmap for the button
      $TK{'mw'}->DefineBitmap('bitmappopoutnw' => 9, 9, $xbmbits);

      # Set $TK{'bitmappopoutnw'} so we don't recreate the bitmappopou
+tnw
      $TK{'bitmappopoutnw'}='true';
    }

    # Create a popout button
    $TK{'popbutton-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Button(-bi
+tmap  => 'bitmappopoutnw',
                                                                   -co
+mmand => sub { &tk_canvasImage({'file'       => $NVP{'File'},
                                                                      
+                                'title'      => $NVP{'Title'},
                                                                      
+                                'boundary'   => $NVP{'Boundary'},
                                                                      
+                                'popout'     => 'false',
                                                                      
+                                'width'      => $NVP{'Width'},
                                                                      
+                                'height'     => $NVP{'Height'},
                                                                      
+                                'background' => $NVP{'Background'},
                                                                      
+                                'boundary'   => $NVP{'Boundary'}}); }
+)->place(-x => 5, -y => 5, -anchor => 'nw');
  }

  #-------------------------------------------------------------------
+--------

  #####  ######  ####  ### ######   ##   #####  #      ######
  #    # #      #       #      #   #  #  #    # #      #
  #    # #####   ####   #     #   #    # #####  #      #####
  #####  #           #  #    #    ###### #    # #      #
  #   #  #      #    #  #   #     #    # #    # #      #
  #    # ######  ####  ### ###### #    # #####  ###### ######

  # Add redraw capability bound to canvas resize event
  if($NVP{'Resizable'} !~ /no|false|^0$|off/i)
  {
    # Bind Canvas resizing to clear and redraw the donut graph
    $TK{'canvas-'.$NVP{'Id'}}->Tk::bind('<Configure>' => sub { # Clear
+ the graph
                                                               $TK{'ca
+nvas-'.$NVP{'Id'}}->delete('all');

                                                               # Redra
+w the graph
                                                               &tk_can
+vasImage({'file'         => $NVP{'File'},
                                                                      
+          'title'        => $NVP{'Title'},
                                                                      
+          'boundary'     => $NVP{'Boundary'},
                                                                      
+          'popout'       => $NVP{'Popout'},
                                                                      
+          'background'   => $NVP{'Background'},
                                                                      
+          'boundary'     => $NVP{'Boundary'},
                                                                      
+          'canvas'       => $TK{'canvas-'.$NVP{'Id'}},
                                                                      
+          'id'           => $NVP{'Id'}}); });
  }


  #-------------------------------------------------------------------
+--------

  #####  ###### ######   ##   #    # #      #####  ####
  #    # #      #       #  #  #    # #        #   #
  #    # #####  #####  #    # #    # #        #    ####
  #    # #      #      ###### #    # #        #        #
  #    # #      #      #    # #    # #        #   #    #
  #####  ###### #      #    #  ####  ######   #    ####

  # Set the Tk title as the parameter
  $NVP{'Title'}='tk_canvasImage() View Image' if($NVP{'Title'} eq '');

  # Default background is white
  $NVP{'Background'}='white' if($NVP{'Background'} eq '');

  # Boundary
  $NVP{'Boundary'}=0 if($NVP{'Boundary'} eq '');

  # Default window to minimum of 200 pixels wide or tall
  $NVP{'Width'}=200 if($NVP{'Width'} < 200);
  $NVP{'Height'}=200 if($NVP{'Height'} < 200);


  #-------------------------------------------------------------------
+--------

   ####  ###### ##### #    # #####
  #      #        #   #    # #    #
   ####  #####    #   #    # #    #
       # #        #   #    # #####
  #    # #        #   #    # #
   ####  ######   #    ####  #

  # Get the image extension
  my $extension=lc(&justext($NVP{'File'}));

  # Make a unique image name - so each picture is unique
  my $imagename=&newkey({'Join'=>''});

  # Set the canvas width minus 2x boundary
  $cw=$cw-2*$NVP{'Boundary'};

  # Set the canvas height minus 2x boundary
  $ch=$ch-2*$NVP{'Boundary'};

  # Set background color
  $TK{'canvas-'.$NVP{'Id'}}->configure(-background => $NVP{'Background
+'});

  # If the image can be read and is a gif or jpg
  if((-r $NVP{'File'}) && ($extension =~ /gif|jpg/i))
  {
    # Get file information
    %file=&getFileInfo($NVP{'File'});

    # Alter extension for jpg - a Tk thing
    $extension='jpeg' if($extension =~ /jpg/);

    # Create an image object for the ploc
    $TK{'image-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo($imagena
+me,
                                                              -file   
+=> $NVP{'File'},
                                                              -format 
+=> $extension);

    # Get original Photo width dimension
    my $picx=$TK{'image-'.$NVP{'Id'}}->width();

    # Get original Photo height dimension
    my $picy=$TK{'image-'.$NVP{'Id'}}->height();

    # Add size to file info
    $file{'width'}=$picx;
    $file{'height'}=$picy;

    # Create an x factor
    my $xfactor=1;

    # Create a y factor
    my $yfactor=1;

    # If the image width is greater than the canvas width - calculate 
+a scaling
    if($picx > $cw)
    {
      # Make the scale factor based on the canvas width relative to th
+e image width
      $xfactor=$picx/($cw+.001);
    }

    # If the image height is greater than the canvas height - calculat
+e a scaling
    if($picy > $ch)
    {
      # Make the scale factor based on the canvas width relative to th
+e image width
      $yfactor=$picy/$ch;
    }

    # Set scaling to x factor
    my $factor=int($xfactor+0.5);

    # Set scaling to greatest of x or y
    if($yfactor > $xfactor)
    {
      $factor=int($yfactor+0.5);
    }

    # Add scale to file info
    $file{'scale'}=$factor;

    #-----------------------------------------------------------------
+--------
    #
    # Resize or not
    #

    # If picy < canvas height and picx < canvas width then display the
+ unscaled image
    if(($picy < $ch) && ($picx < $cw))
    {
      # Display the image
      $TK{'canvasimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->create
+Image(int($cw/2)+$NVP{'Boundary'}, int($ch/2)+$NVP{'Boundary'},
                                                                      
+      -image  => $TK{'image-'.$NVP{'Id'}},
                                                                      
+      -anchor => 'c');
    }
    else
    {
      # Create a second Photo - scaled from information from the origi
+nal image
      $TK{'resizedimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo
+('resized' . $imagename);

      # Rescale the Photo
      $TK{'resizedimage-'.$NVP{'Id'}}->copy($TK{'image-'.$NVP{'Id'}}, 
+-shrink, -subsample => $factor, $factor );

      # Display the image
      $TK{'canvasimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->create
+Image(int($cw/2)+$NVP{'Boundary'}, int($ch/2)+$NVP{'Boundary'},
                                                                      
+      -image  => $TK{'resizedimage-'.$NVP{'Id'}},
                                                                      
+      -anchor => 'c');

      # Get the resized image width
      $picx=$TK{'resizedimage-'.$NVP{'Id'}}->width();

      # Get the resized image height
      $picy=$TK{'resizedimage-'.$NVP{'Id'}}->height();

      # If a popup then resize the popup!
      if(! $NVP{'Canvas'})
      {
        my $geometry=int($picx+2*$NVP{'Boundary'}) .'x' . int($picy+2*
+$NVP{'Boundary'});

        $TK{'pw-'.$NVP{'Id'}}->geometry($geometry);
      }
    }
  }

  # Error could not read file
  else
  {
    # Set the error
    $file{'Error'}="ERROR: Could not read file=$NVP{'file'}";
  }

  # Return the parameter set - which includes the canvas - or just the
+ id
#  return wantarray ? $NVP{'Id'} : $TK{'canvas-'.$NVP{'Id'}};
  return $NVP{'Id'};
}

# End

# Announce
print "execute file=" . __FILE__ . "\n";

## Require the test setup
require "C:/pb/lib/require_test_setup.pl";

# Return if called to not test code
return 1 if($0 ne __FILE__);

## Require included subroutines ... instead of pasting them in here
require "arraytext.pl";
require "data.pl";
require "getFileInfo.pl";
require "greaterof.pl";
require "hash2table.pl";
require "hashtext.pl";
require "justext.pl";
require "longest.pl";
require "newkey.pl";
require "nvp.pl";
require "loadColors.pl";
require "readFile.pl";
require "someday.pl";
require "tabletext.pl";

## Require the tk setup
require "C:/pb/lib/require_tk_setup.pl";

## Required tk subroutines
require "tk_chooseFile.pl";
require "tk_destroyImages.pl";
require "tk_helpAbout.pl";
require "tk_helpDump.pl";
require "tk_popupClose.pl";
require "tk_viewHash.pl";

# Divider
print '- ' x 40 , "\n\n";

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+- - - -
#
# Test cases
#
print "\n$0 Tests begin:\n\n";

# Announce
&tk_console($TK{'console'}, "$0\n");


#---------------------------------------------------------------------
+--------
#
# Test specific Tk code
#

# Create a geometry string for the main window
my $geometry='400x800+800+100';

# Size the popupwindow
$TK{'mw'}->geometry($geometry);

# Add an view table button
$TK{'dib'}=$TK{'mw'}->Button(-text    => 'Destroy Images',
                             -command => \&tk_destroyImages)->pack();

# Add a dump
$TK{'dump'}=$TK{'mw'}->Button(-text    => 'Dump TK',
                              -command => \&tk_helpDump)->pack();

# Add a canvas into the main window for embedded
$TK{'canvas'}=$TK{'mw'}->Canvas('-background' => 'white',
                                '-bd'         => 1,
                                '-relief'     => 'sunken')->pack('-fil
+l'   => 'both',
                                                                 '-anc
+hor' => 'center',
                                                                 '-exp
+and' => 1);


#---------------------------------------------------------------------
+--------
#
# Test #1 - Configuration #1 in a popup window
#
# Add a canvas image button to the test window
my $canvasbutton1 = $TK{'mw'}->Button(-text    => 'Popup canvas image 
+- config 1',
                                      -command => sub { &tk_canvasImag
+e({'background' => 'white',

                                                                      
+   # Link to the image file
                                                                      
+   'file'       => "C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg",

                                                                      
+   # Set the title and poup window height and width - this limits the
+ image display size
                                                                      
+   'Title'      => 'Our Future President',
                                                                      
+   'Width'      => 500,
                                                                      
+   'Height'     => 300,

                                                                      
+   # Set popout false - since it's already a popout
                                                                      
+   'Popout'     => 'false',

                                                                      
+   # Set a background color
                                                                      
+   'background' => $COLOR{'purple'},

                                                                      
+   # Set a boundary around the image
                                                                      
+   'boundary'   => 25,

                                                                      
+   # Set the boundary in pixels around the image in the canvas
                                                                      
+   'boundary'   => 5}); })->pack();


#---------------------------------------------------------------------
+--------
#
# Test #2 - Configuration #2 in the embedded window
#
# Add a canvas image button to the test window
my $canvasbutton2 = $TK{'mw'}->Button(-text    => 'Embeded canvas imag
+e - config 2',
                                      -command => sub { &tk_canvasImag
+e({'canvas'     => $TK{'canvas'},

                                                                      
+   # Link to the image file
                                                                      
+   'file'       => "C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg",

                                                                      
+   # Set popout true
                                                                      
+   'Popout'     => 'true',

                                                                      
+   # Set the title and poup window height and width - this limits the
+ image display size
                                                                      
+   'background' => $COLOR{'lightgray'},

                                                                      
+   # Set the boundary in pixels around the image in the canvas
                                                                      
+   'boundary'   => 20}); })->pack();

# Add a close button to the test window
my $clearbutton = $TK{'mw'}->Button(-text => 'Clear Embedded Canvas', 
+-command => sub{ $TK{'canvas'}->delete('all'); })->pack();


#########################################################

#---------------------------------------------------------------------
+--------


# Start the GUI infinite loop.
MainLoop();


#---------------------------------------------------------------------
+--------

#########################################################


# Announce
print "\n$0 done.\n";

# End

<p>
In any case, here's the full code of tk_canvasImage() just for fun ...
<code>
# PB:-----------------------------------------------------------------
+-------
#
$PB{'tk_canvasImage.pl'}{'Author'}     ="Thomas M.P. Catsburg";
$PB{'tk_canvasImage.pl'}{'Class'}      ="subroutine";
$PB{'tk_canvasImage.pl'}{'Date'}       ="19Jun2018";
$PB{'tk_canvasImage.pl'}{'Description'}="Given a configuration - add a
+n image to a given canvas or use a popup canvas - resize if needed to
+ fit given or actual size";
$PB{'tk_canvasImage.pl'}{'Filename'}   ="tk_canvasImage.pl";
$PB{'tk_canvasImage.pl'}{'Version'}    ="1.0";
#
#  1.0  17Jun2019  Initial writing
#

sub tk_canvasImage
{
  # Get the incoming parameters
  my %NVP=&nvp(@_);


  #-------------------------------------------------------------------
+--------

  ### #####
   #  #    #
   #  #    #
   #  #    #
   #  #    #
  ### #####

  # If not given a key
  if(! defined $NVP{'Id'})
  {
    # Generate a key
    $NVP{'Id'}=&newkey({'Join'=>''});
  }


  #-------------------------------------------------------------------
+--------

   ####    ##   #    # #    #   ##    ####
  #    #  #  #  ##   # #    #  #  #  #
  #      #    # # #  # #    # #    #  ####
  #      ###### #  # # #    # ######      #
  #    # #    # #   ##  #  #  #    # #    #
   ####  #    # #    #   ##   #    #  ####

  # Set a default canvas width
  my $cw=200;

  # Set a default canvas height
  my $ch=200;

  # Need to look for config{'canvas'} and make that the tk{'canvas'} o
+therwise do the popup thing
  if(Tk::Exists($NVP{'Canvas'}))
  {
    # Make the current canvas the given canvas
    $TK{'canvas-'.$NVP{'Id'}}=$NVP{'Canvas'};

    # Update the main window so the canvas sizes
    $TK{'mw'}->update();

    # Get the canvas width
    $cw=$TK{'canvas-'.$NVP{'Id'}}->width();

    # Get the canvas height
    $ch=$TK{'canvas-'.$NVP{'Id'}}->height();
  }
  else
  {
    # Create the popupwindow
    $TK{'pw-'.$NVP{'Id'}}=$TK{'mw'}->Toplevel('-title' => $NVP{'Title'
+});

    # Create a geometry string for the popup
    my $geometry=$NVP{'Width'} . 'x' . $NVP{'Height'};

    # Size the popupwindow
    $TK{'pw-'.$NVP{'Id'}}->geometry($geometry);

    # Set the maximum size for the popup
    $TK{'pw-'.$NVP{'Id'}}->maxsize($NVP{'Width'}, $NVP{'Height'}) if($
+NVP{'Maxsize'} =~ /yes|true|1|on/i);

    # Set the minimum size for the popup
    $TK{'pw-'.$NVP{'Id'}}->minsize($NVP{'Width'}, $NVP{'Height'}) if($
+NVP{'Minsize'} =~ /yes|true|1|on/i);

    # Add main window icon if icon is defined
    if($TK{'icon'})
    {
      # Have no idea what this does but the logo does not work without
+ it
      $TK{'pw-'.$NVP{'Id'}}->idletasks;

      # Change the Tk window and idle icon to the supplied image
      $TK{'pw-'.$NVP{'Id'}}->iconimage($TK{'icon'});
    }

    # Configure the popup window with the new title
    $TK{'pw-'.$NVP{'Id'}}->configure('-title' => $NVP{'Title'});

    # Create the main canvas
    $TK{'canvas-'.$NVP{'Id'}}=$TK{'pw-'.$NVP{'Id'}}->Canvas(-backgroun
+d => $NVP{'Background'},
                                                            -bd       
+  => 1,
                                                            -relief   
+  => 'sunken')->pack(-fill   => 'both',
                                                                      
+                     -anchor => 'center',
                                                                      
+                     -expand => 1);

    # Set the canvas width
    $cw=$NVP{'Width'};

    # Set the canvas height
    $ch=$NVP{'Height'};
  }


  #-------------------------------------------------------------------
+--------

  #####   ####  #####   ####  #    # #####
  #    # #    # #    # #    # #    #   #
  #    # #    # #    # #    # #    #   #
  #####  #    # #####  #    # #    #   #
  #      #    # #      #    # #    #   #
  #       ####  #       ####   ####    #

  # If popout button is true
  if($NVP{'Popout'} =~ /yes|true|^1$|on/i)
  {
    # If bitmappopoutnw does not exist
    if($TK{'bitmappopoutnw'} eq '')
    {
      # Create an xbm bitmap
      my $xbmbits = pack("b9" x 9,
                         ".........",
                         ".11111111",
                         ".1.......",
                         ".1.1111..",
                         ".1.11....",
                         ".1.1.1...",
                         ".1.1..1..",
                         ".1.....1.",
                         ".........");

      # Pack xbmbits into a popout arrow bitmap for the button
      $TK{'mw'}->DefineBitmap('bitmappopoutnw' => 9, 9, $xbmbits);

      # Set $TK{'bitmappopoutnw'} so we don't recreate the bitmappopou
+tnw
      $TK{'bitmappopoutnw'}='true';
    }

    # Create a popout button
    $TK{'popbutton-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Button(-bi
+tmap  => 'bitmappopoutnw',
                                                                   -co
+mmand => sub { &tk_canvasImage({'file'       => $NVP{'File'},
                                                                      
+                                'title'      => $NVP{'Title'},
                                                                      
+                                'boundary'   => $NVP{'Boundary'},
                                                                      
+                                'popout'     => 'false',
                                                                      
+                                'width'      => $NVP{'Width'},
                                                                      
+                                'height'     => $NVP{'Height'},
                                                                      
+                                'background' => $NVP{'Background'},
                                                                      
+                                'boundary'   => $NVP{'Boundary'}}); }
+)->place(-x => 5, -y => 5, -anchor => 'nw');
  }

  #-------------------------------------------------------------------
+--------

  #####  ######  ####  ### ######   ##   #####  #      ######
  #    # #      #       #      #   #  #  #    # #      #
  #    # #####   ####   #     #   #    # #####  #      #####
  #####  #           #  #    #    ###### #    # #      #
  #   #  #      #    #  #   #     #    # #    # #      #
  #    # ######  ####  ### ###### #    # #####  ###### ######

  # Add redraw capability bound to canvas resize event
  if($NVP{'Resizable'} !~ /no|false|^0$|off/i)
  {
    # Bind Canvas resizing to clear and redraw the donut graph
    $TK{'canvas-'.$NVP{'Id'}}->Tk::bind('<Configure>' => sub { # Clear
+ the graph
                                                               $TK{'ca
+nvas-'.$NVP{'Id'}}->delete('all');

                                                               # Redra
+w the graph
                                                               &tk_can
+vasImage({'file'         => $NVP{'File'},
                                                                      
+          'title'        => $NVP{'Title'},
                                                                      
+          'boundary'     => $NVP{'Boundary'},
                                                                      
+          'popout'       => $NVP{'Popout'},
                                                                      
+          'background'   => $NVP{'Background'},
                                                                      
+          'boundary'     => $NVP{'Boundary'},
                                                                      
+          'canvas'       => $TK{'canvas-'.$NVP{'Id'}},
                                                                      
+          'id'           => $NVP{'Id'}}); });
  }


  #-------------------------------------------------------------------
+--------

  #####  ###### ######   ##   #    # #      #####  ####
  #    # #      #       #  #  #    # #        #   #
  #    # #####  #####  #    # #    # #        #    ####
  #    # #      #      ###### #    # #        #        #
  #    # #      #      #    # #    # #        #   #    #
  #####  ###### #      #    #  ####  ######   #    ####

  # Set the Tk title as the parameter
  $NVP{'Title'}='tk_canvasImage() View Image' if($NVP{'Title'} eq '');

  # Default background is white
  $NVP{'Background'}='white' if($NVP{'Background'} eq '');

  # Boundary
  $NVP{'Boundary'}=0 if($NVP{'Boundary'} eq '');

  # Default window to minimum of 200 pixels wide or tall
  $NVP{'Width'}=200 if($NVP{'Width'} < 200);
  $NVP{'Height'}=200 if($NVP{'Height'} < 200);


  #-------------------------------------------------------------------
+--------

   ####  ###### ##### #    # #####
  #      #        #   #    # #    #
   ####  #####    #   #    # #    #
       # #        #   #    # #####
  #    # #        #   #    # #
   ####  ######   #    ####  #

  # Get the image extension
  my $extension=lc(&justext($NVP{'File'}));

  # Make a unique image name - so each picture is unique
  my $imagename=&newkey({'Join'=>''});

  # Set the canvas width minus 2x boundary
  $cw=$cw-2*$NVP{'Boundary'};

  # Set the canvas height minus 2x boundary
  $ch=$ch-2*$NVP{'Boundary'};

  # Set background color
  $TK{'canvas-'.$NVP{'Id'}}->configure(-background => $NVP{'Background
+'});

  # If the image can be read and is a gif or jpg
  if((-r $NVP{'File'}) && ($extension =~ /gif|jpg/i))
  {
    # Get file information
    %file=&getFileInfo($NVP{'File'});

    # Alter extension for jpg - a Tk thing
    $extension='jpeg' if($extension =~ /jpg/);

    # Create an image object for the ploc
    $TK{'image-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo($imagena
+me,
                                                              -file   
+=> $NVP{'File'},
                                                              -format 
+=> $extension);

    # Get original Photo width dimension
    my $picx=$TK{'image-'.$NVP{'Id'}}->width();

    # Get original Photo height dimension
    my $picy=$TK{'image-'.$NVP{'Id'}}->height();

    # Add size to file info
    $file{'width'}=$picx;
    $file{'height'}=$picy;

    # Create an x factor
    my $xfactor=1;

    # Create a y factor
    my $yfactor=1;

    # If the image width is greater than the canvas width - calculate 
+a scaling
    if($picx > $cw)
    {
      # Make the scale factor based on the canvas width relative to th
+e image width
      $xfactor=$picx/($cw+.001);
    }

    # If the image height is greater than the canvas height - calculat
+e a scaling
    if($picy > $ch)
    {
      # Make the scale factor based on the canvas width relative to th
+e image width
      $yfactor=$picy/$ch;
    }

    # Set scaling to x factor
    my $factor=int($xfactor+0.5);

    # Set scaling to greatest of x or y
    if($yfactor > $xfactor)
    {
      $factor=int($yfactor+0.5);
    }

    # Add scale to file info
    $file{'scale'}=$factor;

    #-----------------------------------------------------------------
+--------
    #
    # Resize or not
    #

    # If picy < canvas height and picx < canvas width then display the
+ unscaled image
    if(($picy < $ch) && ($picx < $cw))
    {
      # Display the image
      $TK{'canvasimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->create
+Image(int($cw/2)+$NVP{'Boundary'}, int($ch/2)+$NVP{'Boundary'},
                                                                      
+      -image  => $TK{'image-'.$NVP{'Id'}},
                                                                      
+      -anchor => 'c');
    }
    else
    {
      # Create a second Photo - scaled from information from the origi
+nal image
      $TK{'resizedimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo
+('resized' . $imagename);

      # Rescale the Photo
      $TK{'resizedimage-'.$NVP{'Id'}}->copy($TK{'image-'.$NVP{'Id'}}, 
+-shrink, -subsample => $factor, $factor );

      # Display the image
      $TK{'canvasimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->create
+Image(int($cw/2)+$NVP{'Boundary'}, int($ch/2)+$NVP{'Boundary'},
                                                                      
+      -image  => $TK{'resizedimage-'.$NVP{'Id'}},
                                                                      
+      -anchor => 'c');

      # Get the resized image width
      $picx=$TK{'resizedimage-'.$NVP{'Id'}}->width();

      # Get the resized image height
      $picy=$TK{'resizedimage-'.$NVP{'Id'}}->height();

      # If a popup then resize the popup!
      if(! $NVP{'Canvas'})
      {
        my $geometry=int($picx+2*$NVP{'Boundary'}) .'x' . int($picy+2*
+$NVP{'Boundary'});

        $TK{'pw-'.$NVP{'Id'}}->geometry($geometry);
      }
    }
  }

  # Error could not read file
  else
  {
    # Set the error
    $file{'Error'}="ERROR: Could not read file=$NVP{'file'}";
  }

  # Return the parameter set - which includes the canvas - or just the
+ id
#  return wantarray ? $NVP{'Id'} : $TK{'canvas-'.$NVP{'Id'}};
  return $NVP{'Id'};
}

# End

# Announce
print "execute file=" . __FILE__ . "\n";

## Require the test setup
require "C:/pb/lib/require_test_setup.pl";

# Return if called to not test code
return 1 if($0 ne __FILE__);

## Require included subroutines ... instead of pasting them in here
require "arraytext.pl";
require "data.pl";
require "getFileInfo.pl";
require "greaterof.pl";
require "hash2table.pl";
require "hashtext.pl";
require "justext.pl";
require "longest.pl";
require "newkey.pl";
require "nvp.pl";
require "loadColors.pl";
require "readFile.pl";
require "someday.pl";
require "tabletext.pl";

## Require the tk setup
require "C:/pb/lib/require_tk_setup.pl";

## Required tk subroutines
require "tk_chooseFile.pl";
require "tk_destroyImages.pl";
require "tk_helpAbout.pl";
require "tk_helpDump.pl";
require "tk_popupClose.pl";
require "tk_viewHash.pl";

# Divider
print '- ' x 40 , "\n\n";

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+- - - -
#
# Test cases
#
print "\n$0 Tests begin:\n\n";

# Announce
&tk_console($TK{'console'}, "$0\n");


#---------------------------------------------------------------------
+--------
#
# Test specific Tk code
#

# Create a geometry string for the main window
my $geometry='400x800+800+100';

# Size the popupwindow
$TK{'mw'}->geometry($geometry);

# Add an view table button
$TK{'dib'}=$TK{'mw'}->Button(-text    => 'Destroy Images',
                             -command => \&tk_destroyImages)->pack();

# Add a dump
$TK{'dump'}=$TK{'mw'}->Button(-text    => 'Dump TK',
                              -command => \&tk_helpDump)->pack();

# Add a canvas into the main window for embedded
$TK{'canvas'}=$TK{'mw'}->Canvas('-background' => 'white',
                                '-bd'         => 1,
                                '-relief'     => 'sunken')->pack('-fil
+l'   => 'both',
                                                                 '-anc
+hor' => 'center',
                                                                 '-exp
+and' => 1);


#---------------------------------------------------------------------
+--------
#
# Test #1 - Configuration #1 in a popup window
#
# Add a canvas image button to the test window
my $canvasbutton1 = $TK{'mw'}->Button(-text    => 'Popup canvas image 
+- config 1',
                                      -command => sub { &tk_canvasImag
+e({'background' => 'white',

                                                                      
+   # Link to the image file
                                                                      
+   'file'       => "C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg",

                                                                      
+   # Set the title and poup window height and width - this limits the
+ image display size
                                                                      
+   'Title'      => 'Our Future President',
                                                                      
+   'Width'      => 500,
                                                                      
+   'Height'     => 300,

                                                                      
+   # Set popout false - since it's already a popout
                                                                      
+   'Popout'     => 'false',

                                                                      
+   # Set a background color
                                                                      
+   'background' => $COLOR{'purple'},

                                                                      
+   # Set a boundary around the image
                                                                      
+   'boundary'   => 25,

                                                                      
+   # Set the boundary in pixels around the image in the canvas
                                                                      
+   'boundary'   => 5}); })->pack();


#---------------------------------------------------------------------
+--------
#
# Test #2 - Configuration #2 in the embedded window
#
# Add a canvas image button to the test window
my $canvasbutton2 = $TK{'mw'}->Button(-text    => 'Embeded canvas imag
+e - config 2',
                                      -command => sub { &tk_canvasImag
+e({'canvas'     => $TK{'canvas'},

                                                                      
+   # Link to the image file
                                                                      
+   'file'       => "C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg",

                                                                      
+   # Set popout true
                                                                      
+   'Popout'     => 'true',

                                                                      
+   # Set the title and poup window height and width - this limits the
+ image display size
                                                                      
+   'background' => $COLOR{'lightgray'},

                                                                      
+   # Set the boundary in pixels around the image in the canvas
                                                                      
+   'boundary'   => 20}); })->pack();

# Add a close button to the test window
my $clearbutton = $TK{'mw'}->Button(-text => 'Clear Embedded Canvas', 
+-command => sub{ $TK{'canvas'}->delete('all'); })->pack();


#########################################################

#---------------------------------------------------------------------
+--------


# Start the GUI infinite loop.
MainLoop();


#---------------------------------------------------------------------
+--------

#########################################################


# Announce
print "\n$0 done.\n";

# End

[kcott]

There's an awful lot of problems with that post which you should fix up.

• You should not be posting huge swathes of code like that.
• You've actually posted the same code twice.
• You didn't close the first <code> tag, so you're comment about "just for fun" is lost amongst all the code.
• You should use <spoiler> or <readmore> tags for any large tracts of code or data. See "Writeup Formatting Tips".
• The code you post should reproduce your problem. It should also be presented in a way that we can also run it to try to help you. Absolute pathnames on your machine (e.g. C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg) are of no use to us. See SSCCE.
• You should remove all of the ASCII-art banners. If you think the information they convey is essential, replace with a one-line comment.
• Please read "How do I post a question effectively?".
• Finally, read "How do I change/delete my post?" and then make appropriate modifications.