in reply to Re^3: Tk, threads, and mjpeg stream
in thread Tk, threads, and mjpeg stream

Hehe, just when you think you've got it solved a memory leak crops up! And it's a nasty one; gotta find it.

UPDATE: It's within these two lines 
            $image[ $n ]->delete if $image[ $n ];   ## Addendum: 
            $image[ $n ] = $mw->Photo( -format=>'jpeg', -data=>$data )
+;

[download]
The first one does not seem to be clearing out the previous image, hence when the second line executes my system has more memory space consumed. I take it this problem is within Tk widget distruction? Any ideas from out there? Thanks

Replies are listed 'Best First'.
Re^5: Tk, threads, and mjpeg stream (Tk help required)
by BrowserUk (Patriarch) on Apr 18, 2006 at 21:42 UTC
    UPDATE: It's within these two lines

    I concur. I spent a while trying to find a leak in the threads code before trying this none threaded version--which leaks at exactly the same rate. I've tried various things, but Tk::Photo just seems to be hanging onto some memory somewhere. You may have to go to the Tk list to get answers.

    If anyone can see how to stop this non-threaded version from leaking, it's a fair bet that it would fix the threaded version also. 

    #! perl -slw
use strict;
require Tk;
#use Tk::X11Font;
require Tk::JPEG;
require LWP::UserAgent;
require MIME::Base64;
require IO::Socket;

my $stop = 0;
my $mw = MainWindow->new(title=>"Cams");
$mw->minsize( qw(640 480));
my $top = $mw->Frame()->pack(-side=>'top');
my $bottom = $mw->Frame()->pack(-side=>'bottom');

my @photos =  (
    $top->Label()->pack(-side => 'left'),
    $top->Label()->pack(-side => 'right'),
    $bottom->Label()->pack(-side => 'left'),
    $bottom->Label()->pack(-side => 'right'),
);

my @jpgs = glob $ARGV[0];
my @data = map{ local $/; open my $fh, '<:raw', $_; <$fh> } @jpgs;
my @image;

$mw->Button(-text=>"Stop",-command => sub { $stop=1; })->pack();
$mw->repeat( 1000, sub{
    for my $n ( 0 .. 3 ) {
        my $data = MIME::Base64::encode_base64( $data[ rand @data ] );
        $image[ $n ]->delete if $image[ $n ];
        undef $image[ $n ];
        $image[ $n ] = $mw->Photo( -format=>'jpeg', -data=>$data );
        $photos[ $n ]->configure( -image => $image[ $n ] );
    }
} );

Tk->MainLoop;

    [download]
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]

In Section Seekers of Perl Wisdom