Here is a general purpose example that runs on windows.
#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
#works on Windows
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 d
+ownloads
my @ready = (); #array to hold markers indicating activity is need
+ed
#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){ 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:
}
#####################################################################
There are a few things to remember about threads and perl. Try to create your threads first, before you invoke any other modules, because the thread gets a copy of the existing process, and you can get problems with cross-thread-interference when using modules that are not thread-safe( most modules are not thread-safe ). Try to contain your modules in the threads, if you use LWP, for instance, declare "use LWP;" within the thread code block.
Finally, threads must return or reach the end of their code block before they can be joined or exit without error. It's a common pitfall to watch out for.
Use the Super-search here at Perlmonks and search for "threads" for many examples.
|