|
The problem in this case is Perl 5.8.5. I created the
following test script roughly based on your code:
use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Queue;
use Thread::Semaphore;
my $q = Thread::Queue->new();
my $s = Thread::Semaphore->new();
sub thr
{
while (1) {
$s->up();
my $x = $q->dequeue();
}
}
MAIN:
{
$s->down();
threads->create('thr')->detach();
for (my $ii=1; $ii; $ii++) {
foreach my $jj (1..$ii) {
$s->down();
my $x = &threads::shared::share([]);
push(@$x, $ii, $ii.'_'.$jj, $jj.'_'.$ii);
$q->enqueue($x);
}
}
}
When I ran it under ActivePerl 5.8.4 (there is no Active
Perl 5.8.5) with threads 1.62 and threads::shared 1.12, it
leaked very badly. When I tried it under ActivePerl 5.8.6
and 5.8.8, no leaks. Therefore, Jon should upgrade his
version of Perl, if possible.
The Torrus code looks good. I have one minor suggestion.
You can simplify a bit by not creating shared top variables
that go onto and get assigned from the queue:
Change:
479 my $cmdlist;
480 &threads::shared::share( \$cmdlist );
481 $cmdlist = &threads::shared::share([]);
482 push( @{$cmdlist}, $filename, @cmd );
483 $thrUpdateQueue->enqueue( $cmdlist );
484 $cmdlist = undef;
To:
481 my $cmdlist = &threads::shared::share([]);
482 push( @{$cmdlist}, $filename, @cmd );
483 $thrUpdateQueue->enqueue( $cmdlist );
And change:
507 my $cmdlist;
508 &threads::shared::share( \$cmdlist );
509
510 while(1)
511 {
512 $cmdlist = $thrUpdateQueue->dequeue();
513
514 if( isDebug )
515 {
516 Debug("Updating RRD: " . join(' ', @{$cmdlist}));
517 }
518
519 $rrdtoolSemaphore->down();
520
521 RRDs::update( @{$cmdlist} );
522 my $err = RRDs::error();
523
524 $rrdtoolSemaphore->up();
525
526 if( $err )
527 {
528 Error('ERROR updating' . $cmdlist->[0] . ': ' . $err);
529 $thrErrorsQueue->enqueue( $cmdlist->[0] );
530 }
531
532 $cmdlist = undef;
533 }
To:
510 while(1)
511 {
512 my $cmdlist = $thrUpdateQueue->dequeue();
513
514 if( isDebug )
515 {
516 Debug("Updating RRD: " . join(' ', @{$cmdlist}));
517 }
518
519 $rrdtoolSemaphore->down();
520
521 RRDs::update( @{$cmdlist} );
522 my $err = RRDs::error();
523
524 $rrdtoolSemaphore->up();
525
526 if( $err )
527 {
528 Error('ERROR updating' . $cmdlist->[0] . ': ' . $err);
529 $thrErrorsQueue->enqueue( $cmdlist->[0] );
530 }
533 }
|
(0)
]
