I havn't been able to see an obvious leak in your pseudocode, BUT I have seen this thread leak thing quite a few times myself. If I was to hazard a guess, I would use the fact that a thread (at creation) gets a complete copy of the parent. Now if the parent is retaining references from previous threads, each new thread grows expotentially in size as it carries unwanted garbage forward.

Now there may be some way to re-structure your code, using detach or something, which may release the memory. However this is all "hit-and-miss" and you may spend days trying, and not find the right combination to work right. BrowserUk is very good at this type of thread queue stuff and maybe he will spot a way.

I tend to rely on clunkier, but sure fire methods, so I don't have to think too hard. :-) If you want a sure fire way to prevent memory gains, setup reusable threads. If your limit is 10 threads, at your program start , create 10 sleeping threads and feed them data to process thru shared variables. When it is done processing, return it to sleep, and push it's thread object into a shared array called "@ready". Now you just monitor @ready and shift off an available thread instead of creating a new one. I have an example using Tk, that juggles 3 threads, you can up it to 10. It's a contrived example, so expect some uneeded junk in this code. 

#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use Tk;
use Tk::ActivityBar;
use Tk::Dialog;

my $data = shift || ' ';  #sample code to pass to thread

my %shash;
#share(%shash); #will work only for first level keys
my %hash;
my %workers;
my $numworkers = 3;

foreach my $dthread(1..$numworkers){
 share ($shash{$dthread}{'go'});
 share ($shash{$dthread}{'progress'});
 share ($shash{$dthread}{'timekey'});  #actual instance of the thread
 share ($shash{$dthread}{'frame_open'}); #open or close the frame
 share ($shash{$dthread}{'handle'});
 share ($shash{$dthread}{'data'});
 share ($shash{$dthread}{'pid'});
 share ($shash{$dthread}{'die'});
 
 $shash{$dthread}{'go'} = 0;
 $shash{$dthread}{'progress'} = 0;
 $shash{$dthread}{'timekey'} = 0;
 $shash{$dthread}{'frame_open'} = 0; 
 $shash{$dthread}{'handle'} = 0;
 $shash{$dthread}{'data'} = $data;
 $shash{$dthread}{'pid'} = -1;
 $shash{$dthread}{'die'} = 0;
 $hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
}

my $mw = MainWindow->new(-background => 'gray50');

my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'left' ,-fill=>'y');
my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'right',-fill =>'both' );

my %actives = ();   #hash to hold reusable numbered widgets used for d
+ownloads
my @ready = ();     #array to hold markers indicating activity is need
+ed
my $activity = $lframe->ActivityBar()->pack(-side => 'top',-anchor => 
+'n');

#make 3 reusable downloader widget sets-------------------------
foreach(1..$numworkers){
   push @ready, $_;
#frames to hold indicator
$actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );

$actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
        -text       => "Stop Worker $_",
        -background => 'lightyellow',
        -command    => sub {  } )->pack( -side => 'left', -padx => 10 
+);

$actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
         -width       => 3,
     -background => 'black',
     -foreground => 'lightgreen',
         -textvariable => \$shash{$_}{'progress'},
    )->pack( -side => 'left' );

$actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
         -width       => 1,
         -text        => '%',
     -background  => 'black',
     -foreground  => 'lightgreen',
    )->pack( -side => 'left' );


$actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
          -text        => '',
     -background  => 'black',
     -foreground  => 'skyblue',
    )->pack( -side => 'left',-padx =>10 );

}
#--------------------------------------------------

my $button = $lframe->Button(
    -text       => 'Get a worker',
    -background => 'lightgreen',
    -command    => sub { &get_a_worker(time) } 
           )->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady 
+=> 20 );

my $text = $rframe->Scrolled("Text",
                   -scrollbars => 'ose',
                   -background => 'black',
                   -foreground => 'lightskyblue',
                   )->pack(-side =>'top', -anchor =>'n');

my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $lframe->Button(
    -text       => 'Start Test Count',
    -background => 'hotpink',
    -command    => sub {
        my $count = 0;
        $startbut->configure( -state => 'disabled' );
        $repeat = $mw->repeat(
            100,
            sub {
                $count++;
                $text->insert( 'end', "$count\n" );
                $text->see('end');
            }
        );
        $repeaton = 1;
    })->pack( -side => 'top',  -fill=>'x', -pady => 20);

my $stoptbut = $lframe->Button(
    -text    => 'Stop Count',
    -command => sub {
        $repeat->cancel;
        $repeaton = 0;
        $startbut->configure( -state => 'normal' );
    })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 )
+;

my $exitbut = $lframe->Button(
    -text    => 'Exit',
    -command => sub {
        
        foreach my $dthread(keys %hash){
          $shash{$dthread}{'die'} = 1;
          $hash{$dthread}{'thread'}->join
     }
        
         if ($repeaton) { $repeat->cancel }
           #foreach ( keys %downloads ) {
           #    #$downloads{$_}{'repeater'}->cancel;
           #}
      # $mw->destroy;    
       exit;
      })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20
+ );


#dialog to get file url---------------------
    my $dialog = $mw->Dialog(
        -background => 'lightyellow',
        -title      => 'Get File',
        -buttons    => [ "OK", "Cancel" ]
    );

    my $hostl = $dialog->add(
        'Label',
        -text       => 'Enter File Url',
        -background => 'lightyellow'
    )->pack();

    my $hostd = $dialog->add(
        'Entry',
        -width        => 100,
        -textvariable => '',
        -background   => 'white'
    )->pack();

$dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );

   my $message = $mw->Dialog(
        -background => 'lightyellow',
        -title      => 'ERROR',
        -buttons    => [ "OK" ]
    );

  my $messagel = $message->add(
               'Label',
        -text       => '       ',
    -background => 'hotpink'
    )->pack();

$mw->repeat(10, sub{  
   if(scalar @ready == $numworkers){return}
         
   foreach my $set(1..$numworkers){  
     $actives{$set}{'label1'}->
         configure(-text =>\$shash{$set}{'progress'});
       
         if(($shash{$set}{'go'} == 0) and
        ($shash{$set}{'frame_open'} == 1)) 
        { 
            my $timekey = $shash{$set}{'timekey'};
           $workers{ $timekey }{'frame'}->packForget; 
       $shash{$set}{'frame_open'} = 0;    
       push @ready, $workers{$timekey}{'setnum'};              
       if((scalar @ready) == 3)
          { $activity->configure(-value => 0) }
          $workers{$timekey} = ();
         delete $workers{$timekey};
           }
        }
    });

$mw->MainLoop;
#####################################

sub get_a_worker {

   my $timekey = shift;

  $hostd->configure( -textvariable => \$data);
  if ( $dialog->Show() eq 'Cancel' ) { return }

#----------------------------------------------
#get an available frameset
my $setnum; 
  if($setnum = shift @ready){print "setnum->$setnum\n"}
    else{ print "no setnum available\n"; return}

$workers{$timekey}{'setnum'} = $setnum;
$shash{$setnum}{'timekey'} = $timekey;

$workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
$workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );

$workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
$workers{$timekey}{'stopbut'}->configure(
         -command => sub { 
        $workers{$timekey}{'frame'}->packForget; 
        $shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
        $shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;    
        push @ready, $workers{$timekey}{'setnum'};              
        if((scalar @ready) == $numworkers)
          { $activity->configure(-value => 0) }
           $workers{$timekey} = ();
           delete $workers{$timekey};
                });

$workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
$workers{$timekey}{'label1'}->configure(
              -textvariable => \$shash{$setnum}{'progress'},
           );

$workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};


$workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
$workers{$timekey}{'label3'}->configure(-text => $timekey);

$activity->startActivity();

$shash{$setnum}{'go'} = 1; 
$shash{$setnum}{'frame_open'} = 1; 
#--------end of get_file sub--------------------------
}

#################################
sub work{
  my $dthread = shift;
    $|++; 
    while(1){
       if($shash{$dthread}{'die'} == 1){ goto END }; 
      
       if ( $shash{$dthread}{'go'} == 1 ){

    eval( system( $shash{$dthread}{'data'} )    );

   foreach my $num (1..100){
          $shash{$dthread}{'progress'} = $num; 
       print "\t" x $dthread,"$dthread->$num\n";
       select(undef,undef,undef, .5);
       if($shash{$dthread}{'go'} == 0){last}
       if($shash{$dthread}{'die'} == 1){ goto END }; 
       }
       
    $shash{$dthread}{'go'} = 0; #turn off self before returning      
       }else
         { sleep 1 }
    }
END:
}
##############################

[download]
I'm not really a human, but I play one on earth. Cogito ergo sum a bum

In reply to Re: Threads in Perl: Just leaky? by zentara
in thread Threads in Perl: Just leaky? by TheShrike

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.