Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Parallel download Tk

by Takamoto (Scribe)
on Dec 30, 2018 at 21:39 UTC ( #1227829=perlquestion: print w/replies, xml ) Need Help??

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) ?

Replies are listed 'Best First'.
Re: Parallel download Tk
by tybalt89 (Prior) on Dec 30, 2018 at 22:19 UTC

    I've used Tk::IO for things like this. It lets the UI continue to be active.

Re: Parallel download Tk
by bliako (Prior) 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...

      I guess, I underestimated the complexity of the subject. I'll have a closer look at Tk::IO. Unfortunately the documentation is quite short (almost nonexistent).

        Here's an example of Tk::IO

        You'll have to write a separate perl program to fetch URLs. In this example I faked that part with a simple shell script just as a proof of concept.

        #!/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.

Re: Parallel download Tk ( threads Thread::Queue LWP::UserAgent WWW::Mechanize)
by Anonymous Monk on Jan 01, 2019 at 09:09 UTC

    Hi

    Example

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

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.

      As far as i remember Tk isn‘t really thread-safe. Please correct me if i‘m wrong. Regards, Karl

      «The Crux of the Biscuit is the Apostrophe»

      perl -MCrypt::CBC -E 'say Crypt::CBC->new(-key=>'kgb',-cipher=>"Blowfish")->decrypt_hex($ENV{KARL});'Help

        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]

      A least on Windows (I will try later on macOS), it always fires errors like:

      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).

        Sorry about that. Tk being non thread-safe does, indeed, complicate things.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1227829]
Approved by Discipulus
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (8)
As of 2021-06-25 09:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)












    Results (135 votes). Check out past polls.

    Notices?