Beefy Boxes and Bandwidth Generously Provided by pair Networks Bob
Perl Monk, Perl Meditation
 
PerlMonks  

Re^3: convert a single thread application to multithread with GUI

by zentara (Archbishop)
on Jul 11, 2007 at 13:17 UTC ( #626003=note: print w/ replies, xml ) Need Help??


in reply to Re^2: convert a single thread application to multithread with GUI
in thread convert a single thread application to multithread with GUI

Here's a simple Tk idea. (I use END: blocks in the thread to emphasize what is happening, but simple returns will suffice)

#!/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 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: } #####################################################################

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


Comment on Re^3: convert a single thread application to multithread with GUI
Download Code
Re^4: convert a single thread application to multithread with GUI
by ultibuzz (Monk) on Jul 11, 2007 at 13:49 UTC

    thats an awsome exaple, now i know how to make a cmd like text scrollbox ;)
    also the thread reuse thing is now a bit clearer
    thx for the nice example and i hope it will push me in the right direction

    kd ultibuzz

      One thing I forgot to mention is that threads can share a filehandle thru the fileno, so that can help in logging. Your main thread can open the FH to the log, then you send the fileno of the FH to the threads, and they can print to it. See FileHandles and threads

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

        cheers,
        yeah shared FH i know.
        but i encounter another problem, the TK- Scrolled object wich is used to display eat up all memory ;).
        is there a way to limit the box to 1000 lines and then it shoud overwrite ?, so it will not write the memory full :D.

        kd ultibuzz

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://626003]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (8)
As of 2014-04-21 15:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (495 votes), past polls