note
Anonymous Monk
<p> Hi
<p> Example <c>
#!/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__
</c>
<p> Tips
<br> [id://1176998|Re: Perl Tk nonblocking (threads queue)]
<br> [id://1131558| Re: Basic examples of perl/tk and fork ]
1227829
1227829
13