Takamoto has asked for the wisdom of the Perl Monks concerning the following question:
Hello, I need again some monks advise on which road I should walk to modify my code and perform a parallel operation. The code below is part of a small Tk UI. In this portion of the code, the program downloads information from the Web (using LWP::UserAgent and other modules). The results are stored in arrays which are used (they get merged) AFTER all data has been collected. Now the script works serially, which is fine. However, I would like - if possible - to perform the download in parallel so that I can save time while downloading.
#parallel should START here
if ($UseDataOne eq 1){
@DataOne=GetDataOne(@TableParameters);
}
if ($UseDatatwo eq 1){
@Datatwo=GetDatatwo(@TableParameters);
}
if ($UseDataThree eq 1){
@DataThree=GetDataThree(@TableParameters);
}
if ($UseDataFour eq 1){
@DataFour=GetDataFour(@TableParameters);
}
#program should wait here till all 4 arrays are ready
I am totally new to parallel processing, I have tried to integrate subs::parallel but without success (no matter what I try I get always Too many arguments for subs::parallel::parallelize (this is surely due to my inexperience in integrating the module with the rest of the code). I have also read that with Tk parallel processing is not easy, so better ask for your opinion. Do you know any working examples that could help me better understand how to proceed (and that can be possibly used with Tk) ?
Re: Parallel download Tk
by tybalt89 (Monsignor) on Dec 30, 2018 at 22:19 UTC
|
| [reply] |
Re: Parallel download Tk
by bliako (Monsignor) on Dec 31, 2018 at 10:04 UTC
|
In a similar question: LWP::UserAgent timeout, I have suggested HTTP::Async which downloads a list of urls and reports back when done. If you want a list of urls to be fetched in parallel, there is LWP::Parallel::UserAgent. The latter will block until all urls are fethced. But they are fetched in parallel, so bandwidth and server allowing, it will probably be faster than sequential download. The former will not block, you check on progress by asking it.
However, the bottomline on answers on said question, and in this one too, is that you need to familiarise yourself with Tk::IO because:
I'd just add that, in either case, given that you are dealing with a GUI, it's usually a best practice to use a separate thread for the UI events processing and another for the processing (markong):
So, elevate yourself this festive season with multi-threading... | [reply] |
|
| [reply] |
|
#!/usr/bin/perl
# https://perlmonks.org/?node_id=1227829
use strict;
use warnings;
use Tk;
use Tk::IO;
use Tk::ROText;
my (@data1, @data2, @data3, @data4);
my $complete1 = my $complete2 = my $complete3 = my $complete4 = 0;
my $status = 'Ready to Start';
my $mw = MainWindow->new;
$mw->Button(-text => 'Load', -command => \&startload,
)->pack;
$mw->Label(-textvariable => \$status,
)->pack;
$mw->Button(-text => 'Exit', -command => sub{$mw->destroy},
)->pack(-side => 'bottom');
$_ = $mw->ROText( -width => 40,
)->pack(-side => 'left') for my ($t1, $t2, $t3, $t4);
MainLoop;
sub startload
{
$status = 'Started';
child( \@data1, \$complete1, 'one', 'sleep 1; echo data one', $t1 );
child( \@data2, \$complete2, 'two', 'sleep 3; echo data two', $t2 );
child( \@data3, \$complete3, 'three', 'sleep 4; echo data three', $t
+3 );
child( \@data4, \$complete4, 'four', 'sleep 2; echo data four', $t4
+);
}
sub common
{
$complete1 && $complete2 && $complete3 && $complete4 or return;
$status = 'All Completed';
# do final processing here #####################
}
sub child
{
my ($refdata, $refcomplete, $message, $command, $rotext) = @_;
@$refdata = ();
$$refcomplete = 0;
$rotext->delete('1.0' => 'end');
Tk::IO->new(
-linecommand => sub {push @$refdata, shift},
-childcommand => sub {
$$refcomplete = 1;
$status = "$message completed";
$rotext->insert(end => join '', @$refdata);
common();
},
)->exec($command);
}
There are a couple other examples of Tk::IO on this site, you can search for them if you want.
| [reply] [d/l] |
|
| [reply] |
Re: Parallel download Tk ( threads Thread::Queue LWP::UserAgent WWW::Mechanize)
by Anonymous Monk on Jan 01, 2019 at 09:09 UTC
|
#!/usr/bin/perl --
## perltidy -olq -csc -csci=10 -cscl="sub : BEGIN END" -otr -opr -ce
+-nibc -i=4 -pt=0 "-nsak=*"
use strict;
use warnings;
use threads stack_size => 4096;
use Thread::Queue;
Main( @ARGV );
exit( 0 );
sub Main {
my $qin = Thread::Queue->new(); ## jobs to do in background
my $qout = Thread::Queue->new(); ## results for gui in foreground
my $guithread = threads->create( \&tkgui, $qin, $qout );
## don't wait for background downloading service workers / mechtitles
threads->create( \&mechtitles, $qin, $qout ) for 1 .. 2;
$guithread->join; ## wait for gui to finish
return;
} ## end sub Main
sub mechtitles {
my( $qin, $qout ) = @_;
threads->detach(); ## can't join this thread it returns nothing
+ :)
require WWW::Mechanize;
require Time::HiRes;
my $ua = WWW::Mechanize->new( autocheck => 0 );
while( 1 ) {
#~ if( defined( my $url = $qin->popnow ) ) {
if( defined( my $url = $qin->pop ) ) {
$ua->get( $url );
my $title = eval { $ua->title };
$title ||= $ua->res->status_line;
my $worker = sprintf 'worker(%s)', threads->tid;
$qout->push( "$worker $url =>\n $title\n" );
}
Time::HiRes::usleep( 33 * 1000 );
## sleep microseconds
## be "nice" give other thread a time slice
}
} ## end sub mechtitles
sub tkgui {
my( $qin, $qout ) = @_;
require Tk;
#~ require Tk::ROText;
my $mw = Tk::tkinit();
my $pending = "";
my $l = $mw->Label( -textvariable => \$pending )->pack;
#~ my $t = $mw->ROText()->pack;
my $t = $mw->Text()->pack;
my $b = $mw->Button( -text => 'enqueue another 3 example.com', )->
+pack;
$b->configure( -command => [ \&q_pusher, $b, $qin, ], );
$b->focus;
$mw->repeat(
500, ## millisecond
[ \&pop_to_pending, $t, \$pending, $qin, $qout, ],
);
$mw->MainLoop;
return;
} ## end sub tkgui
sub q_pusher {
my( $b, $qin ) = @_;
$qin->push( 'http://example.com' ) for 1 .. 4;
#~ $b->configure( -state => "disabled" );
return;
}
sub pop_to_pending {
my( $t, $pending, $qin, $qout ) = @_;
if( defined( my $item = $qout->popnow ) ) {
$t->insert( q!end!, join( '', $item ) );
}
$$pending = 'Jobs awaiting workers ' . $qin->pending;
$t->update;
return;
}
sub Thread::Queue::append { goto &Thread::Queue::enqueue }
sub Thread::Queue::remove { goto &Thread::Queue::dequeue }
sub Thread::Queue::push { goto &Thread::Queue::enqueue }
sub Thread::Queue::shift { goto &Thread::Queue::dequeue }
sub Thread::Queue::popnow { goto &Thread::Queue::dequeue_nb }
sub Thread::Queue::pop { goto &Thread::Queue::dequeue }
__END__
Tips
Re: Perl Tk nonblocking (threads queue)
Re: Basic examples of perl/tk and fork
| [reply] [d/l] |
Re: Parallel download Tk
by Anonymous Monk on Dec 31, 2018 at 08:40 UTC
|
This looks like a use case for threads.
use threads;
my @data;
if ($UseDataOne eq 1){
push @data, async { [ GetDataOne(@TableParameters) ] };
}
if ($UseDatatwo eq 1){
push @data, async { [ GetDatatwo(@TableParameters) ] };
}
if ($UseDataThree eq 1){
push @data, async { [ GetDataThree(@TableParameters) ] };
}
if ($UseDataFour eq 1){
push @data, async { [ GetDataFour(@TableParameters) ] };
}
@data = map { $_->join } @data;
Now @data is an array of arrays containing your portions of data. | [reply] [d/l] [select] |
|
| [reply] [d/l] |
|
Tk isn't thread safe, but there are ways how to use it with threads safely - basically, load it into one thread only (which means require instead of use) and don't share anything from it. For an example, see PM::CB::G.
map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
| [reply] [d/l] |
|
Attempt to free nonexistent shared string 'Tk::Button=HASH(0x88256ec)'
+, Perl interpreter: 0x8b06784 at C:/berrybrew/5.28.0_32/perl/site/lib
+/Tk/Balloon.pm line 150 during global destruction.
Free to wrong pool 8a89560 not c69f50 at C:/berrybrew/5.28.0_32/perl/s
+ite/lib/Tk/Widget.pm line 363 during global destruction.
From the first thread to the last one (and merging of all arrays) nothing happens with the GUI and no Tk code involved in the subroutines (the GUI may also freeze which is okay in may case). | [reply] [d/l] |
|
Sorry about that. Tk being non thread-safe does, indeed, complicate things.
| [reply] |
|
|