Re: Perl threads

On Tue, 31 Jul 2007 04:44:12 -0000, ivakras1@xxxxxxxxx wrote:

is to make main program work with no pauses for waiting joined thread
or something else, it causes packet missing.
I would suspect that the startup time for the thread, is where the
packets are being lost. Especially if the system load is heavy, the
thread takes time to set itself up. You may need to rethink your
approach to this.

I tried to fire up
threads with detach (threads creates fast, 10-20 per second). But when
the main program is done (by ctrl+c or else) - perl warns me the
number of threads still running. How can i get this number by myself
to wait for detached threads dies?

When you detach a thread, the main thread forgets about it, so there is
no way to get them without keeping track of them yourself.

Make a shared array or scalar, to keep track of your threads.
When you create a thread, push it's identifier ( use a hash ) onto
the array.
At the end of the thread code block, just before it exits, have it
remove it's name from the array.

Then you can tell how many threads you have running, by the
scalar count of the array.

If you want to terminate early, remember, you will need a "$die" shared
variable, to tell the remaining threads to return immediately, and then
you can cleanly exit. (This means your thread code block needs to be
written to check for $die often.

One word of warning, about spawning alot of detached threads containing
object code from some module......... you may very well will gain memory
as the script runs, if the cleanup of refcounts is not good. You may get
lucky, but it is something to watch out for. It is very dis-heartening
to spend a bunch of time getting it all to work, only to find it sucks
up ram like a vacuum cleaner. :-)

Personally, if speed is important, to avoid missing packets, I would
create a bank of reusable joinable threads, that you can cycle thru.
You may also want to ask this on http://perlmonks.org, where a fellow
named BrowserUk may be able to show you how to use thread->queue.
I'm a "crude crafter" and like to hammer all my stuff together with
shared variables and event loops, but there are some more sophisticated
techniques out there.

Here is an example of a reusable thread-bank. I create 3 threads, and
when they finish, they get pushed back into an array for the next
available job. It also shows you how to track your threads with a shared
hash.


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

#works on WindowsME ActiveState 5.8.6.811

my $data = shift || 'date'; #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);
}


use Tk;
use Tk::Dialog;

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
downloads
my @ready = (); #array to hold markers indicating activity is needed

#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)
{ }
$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)
{ }
$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);



$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){ return };

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){ return };
}

$shash{$dthread}{'go'} = 0; #turn off self before returning
}else
{ select(undef,undef,undef,.1) }
}
}
#####################################################################

__END__



--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html
.