i could try the questions and close the widgets BEFORE launching the threads but not the opposite
The idea is to launch as many worker threads as you think you need, right at the beginning, and put them into a sleep loop until you want to wake them. Then make your gui code, and wake up and feed the pre-made threads your command to perform. Finally always program a way so that you can reuse your workers, instead of killing them off and creating new ones.
Just for your education, you can pass strings to your threads to be eval'd, this makes it easy to reuse threads. For example, look at the simple thread code in this example. You can ask your questions at anytime after the threads are formed, and pass in code to be eval'd by the thread, thru a shared variable.
Finally, Gtk2 does have some thread safety built-in, allowing you to make widgets as the threads are formed, but it is full of difficulty to get it right. Even in Gtk2, the advice remains the same, make your threads first, before gui code.
#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
# works on Windows as far as my limited testing goes
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:
}
#####################################################################
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.