I have a perl object with a few functions in it. Each functions is called once from the main program. I would like to run some of the functions in parallel to save time. I can't run all of them together since some functions depend on the results of previous functions.
I thought of something like this:
For each function keep a flag that is initialized to false and is set to true by the function when it ends (e.g. the last line in func1 would be $is_func1_done = 1).
Start each function with a loop that waits until all the flags of the functions it depends on are true. For example: if func1 depends on func2 and func3 then:
sub func1 {
while (!($is_func2_done && $is_func3_done)) {
# do nothing
}
# do work
}
Then I can start immediately a thread for each function, but the actual work of each function will start only when it's ready. Does this make sense? Do I need any locks here on the flags? Is using such while loops common? -- the term busy waiting comes to mind... maybe most of my CPU time will be spent on these whiles? Is there a more standard solution to this?
Does this make sense?
Yes - each task knows its preconditions, and waits for them to be met before executing. It's one of a number of valid designs, though you might find it difficult to scale as the number of tasks grow and their interdependencies grow more complex.
Do I need any locks here on the flags?
Yes. The flags need to be shared, so that one thread can manipulate them and another see it, and shared variables need to be lock()ed to be used safely.
Is using such while loops common? -- the term busy waiting comes to mind
Sadly yes, but Don't Do That, Please. Shared variables in perl can serve as condition variables through which threads can send notifications to one another:
sub func1 {
{
lock(%shared_state);
until ($shared_state{ "func2 done" } and $shared_state{ "func3 done" }) {
cond_wait(%shared_state);
}
}
# do work -- note that %shared_state is unlocked
# now tell others that we're done
lock(%shared_state);
$shared_state{ "func1 done" } = 1;
cond_broadcast(%shared_state);
# %shared_state will be unlocked, and broadcast delivered when we leave this scope
}
When you cond_wait, the shared variable is unlocked and your thread is put to sleep. No need to busy loop.
Is there a more standard solution to this?
$thr->join, as Sinan suggests, is an easy and natural way to wait for a specific thread to finish running. Thread::Semaphore can serve a similar but more complex function (and, helpfully, can be initialized to values less than zero). A common need to "wait for these 5 threads to finish something" can be achieved with a Thread::Barrier. TMTOWTDI.
You should use $thr->join to wait for a thread to finish.
For example:
#!/usr/bin/perl
use strict; use warnings;
use threads;
my #threads = map threads->create($_), qw( func1 func2 );
$_->join for #threads;
my $thr3 = threads->create('func3');
$thr3->join;
sub func1 {
for (1 .. 5) {
print "func1\n";
sleep 1 + rand 3;
}
return;
}
sub func2 {
for (1 .. 5) {
print "func2\n";
sleep 1 + rand 2;
}
return;
}
sub func3 {
print "Time to do some work\n";
}
I don't know if it is common to use such while loops: I would not.
Related
I have the following code:
foreach my $inst (sort keys %{ ... }) {
next if (...)
somefuntion($a, $b, $c, $inst);
}
I would like to run this function on all the $inst-s asynchronously.
I tried to make it multi-threaded, but I'm having trouble with the syntax or implementation.
*** EDIT: ***
Apparently (i haven't noticed until now), the function uses a hash and the updates gets lost.
Should Threads::shared help in this case? Is it relevant in this case or should I just try forks?
Perl's got three major ways I'd suggest to do parallel code
Threads
Forks
Nonblocking IO
The latter isn't strictly speaking 'parallel' in all circumstances, but it does let you do multiple things at the same time, without waiting for each to finish, so it's beneficial in certain circumstances.
E.g. maybe you want to open 10 concurrent ssh sessions - you can just do an IO::Select to find which of them are 'ready' and process them as they come in.
The ssh shells themselves are of course, separate processes.
But when doing parallel, you need to be aware of a couple of pitfalls - one being 'self denial of service' - you can generate huge resource consumption very easily. The other being that you've got some inherent race conditions, and no longer a deterministic flow of program - that brings you a whole new class of exciting bugs.
Threads
I wouldn't advocate spawning a thread-per-instance, as that scales badly. Threads in perl are NOT lightweight, like you might be assuming. That means that implementing them as if they are, gives you a denial of service condition.
What I'd typically suggest is running with Thread::Queue and some "worker" threads - and use the Queue to pass data to some number of workers that are scaled to your resource availability. Depending on what is your limiting factor here that's making you do parallel.
(e.g. disk, network, cpu, etc.)
So to use a simplistic example that I've posted previously:
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use Thread::Queue;
my $nthreads = 5;
my $process_q = Thread::Queue->new();
my $failed_q = Thread::Queue->new();
#this is a subroutine, but that runs 'as a thread'.
#when it starts, it inherits the program state 'as is'. E.g.
#the variable declarations above all apply - but changes to
#values within the program are 'thread local' unless the
#variable is defined as 'shared'.
#Behind the scenes - Thread::Queue are 'shared' arrays.
sub worker {
#NB - this will sit a loop indefinitely, until you close the queue.
#using $process_q -> end
#we do this once we've queued all the things we want to process
#and the sub completes and exits neatly.
#however if you _don't_ end it, this will sit waiting forever.
while ( my $server = $process_q->dequeue() ) {
chomp($server);
print threads->self()->tid() . ": pinging $server\n";
my $result = `/bin/ping -c 1 $server`;
if ($?) { $failed_q->enqueue($server) }
print $result;
}
}
#insert tasks into thread queue.
open( my $input_fh, "<", "server_list" ) or die $!;
$process_q->enqueue(<$input_fh>);
close($input_fh);
#we 'end' process_q - when we do, no more items may be inserted,
#and 'dequeue' returns 'undefined' when the queue is emptied.
#this means our worker threads (in their 'while' loop) will then exit.
$process_q->end();
#start some threads
for ( 1 .. $nthreads ) {
threads->create( \&worker );
}
#Wait for threads to all finish processing.
foreach my $thr ( threads->list() ) {
$thr->join();
}
#collate results. ('synchronise' operation)
while ( my $server = $failed_q->dequeue_nb() ) {
print "$server failed to ping\n";
}
This will start 5 threads, and queue up some number of jobs, such that 5 are running in parallel at any given time, and 'unwind' gracefully after.
Forking
Parallel::Forkmanager is the tool for the job here.
Unlike threads, forks are quite efficient on a Unix system, as the native fork() system call is well optimised.
But what it's not so good at is passing data around - you've got to hand roll any IPCs between your forks in a way that you don't so much with Threads.
A simple example of this would be:
#!/usr/bin/perl
use strict;
use warnings;
use Parallel::ForkManager;
my $concurrent_fork_limit = 4;
my $fork_manager = Parallel::ForkManager->new($concurrent_fork_limit);
foreach my $thing ( "fork", "spoon", "knife", "plate" ) {
my $pid = $fork_manager->start;
if ($pid) {
print "$$: Fork made a child with pid $pid\n";
} else {
print "$$: child process started, with a key of $thing ($pid)\n";
}
$fork_manager->finish;
}
$fork_manager->wait_all_children();
This does spawn off subprocesses, but cleans up after them fairly readily.
Nonblocking IO
Using IO::Select you would open some number of filehandles to subprocesses, and then use the can_read function to process the ones that are ready to run.
The perldoc IO::Select covers most of the detail here, which I'll reproduce for convenience:
use IO::Select;
$select = IO::Select->new();
$select->add(\*STDIN);
$select->add($some_handle);
#ready = $select->can_read($timeout);
#ready = IO::Select->new(#handles)->can_read(0);
You could use threads.
Here's an example that should take about 5 seconds to finish although it calls sleep(5) twice:
#!/usr/bin/perl
use strict;
use warnings;
use threads;
my %data = (
'foo' => 'bar',
'apa' => 'bepa',
);
sub somefuntion {
my $key = shift;
print "$key\n";
sleep(5);
return $data{$key};
}
my #threads;
for my $inst (sort keys %data) {
push #threads, threads->create('somefuntion', $inst);
}
print "running...\n";
for my $thr (#threads) {
print $thr->join() . "\n";
}
print "done\n";
This answer was made to show how threads works in Perl because you mentioned threads. Just a word of caution:
The "interpreter-based threads" provided by Perl are not the fast, lightweight system for multitasking that one might expect or hope for. Threads are implemented in a way that makes them easy to misuse. Few people know how to use them correctly or will be able to provide help.
The use of interpreter-based threads in perl is officially discouraged.
$^T stores the start time of a perl program in second since epoch.
Because I need to know how many seconds a child thread costs, the question is:
Does $^T in child thread store the beginning time of itself? or simply copy the value from its mother thread?
Running this:
#!/usr/bin/env perl
use strict;
use warnings;
sub test_th {
print $^T,"\n";
}
print $^T."\n"
sleep 10;
my $thr = threads -> create ( \&test_th );
$thr -> join;
Prints the same value twice.
Which is as expected, since when you thread, you effectively inherit all your parent variables.
If you try this via forking:
#!/usr/bin/env perl
use strict;
use warnings;
use Parallel::ForkManager;
print $^T, "\n";
for ( 1 .. 2 ) {
sleep 10;
$mgr->start and next;
print $^T, "\n";
$mgr->finish;
}
$mgr->wait_all_children;
You get the same value, despite the 'start' of the fork being 10s later.
So to answer your question - no, $^T is started at program instantiation. If you wish to measure things like thread run times, you'll have to find other ways of doing it.
Although, given "elapsed time" is at best a very crude metric (processors doing things like scheduling, such that 'real time' and 'run time' don't really correlate particularly)
But perhaps calling time() at start and end of each thread would give you what you need? Or perhaps something like Devel::NYTProf?
A quick test will reveal that $^T is defined for the populated at process startup, not at thread startup
But nothing's stopping you from noting when the thread starts. You can even save the time stamp in $^T since it's a per-thread variable!
use feature qw( say );
use threads;
sub thread {
my ($n) = #_;
sleep $n;
}
sub wrapper {
my ($n) = #_;
$^T = time;
thread($n);
say sprintf "Thread %s ran for %s seconds.", threads->tid, time-$^T;
}
async { wrapper(5) };
sleep 2;
async { wrapper(2) };
$_->join for threads->list;
Output:
Thread 2 ran for 2 seconds.
Thread 1 ran for 5 seconds.
Note that assigning to $^T coerces the stored value into an integer, so it would not be an appropriate place to store the result of Time::HiRes::time().
use threads;
use threads::shared;
use Term::ReadKey;
sub input_worker {
local $SIG{'KILL'} = sub { threads->exit(0); return;};
while (1) {
if (defined(my $char = ReadKey 0, *STDIN)) {
print "$char";
}
}
return;
} ## end sub input_worker
my $in_thr = threads->create(\&input_worker);
sleep 5;
my $rc = $in_thr->kill('KILL')->join();
print "$rc\n";
This program wont exit by itself and just hangs.
It will only exit after pressing "enter"
How can i make it so that it will exit by itself after 'kill' is signaled
P.S. I dont want to use detach();
Mixing signals and threads is a bit of a challenge, simply because $thread->kill doesn't actually use real signals (since signals are sent to processes, not threads). Which is just as well, because if it did, SIGKILL can break things.
Even when talking about 'normal' signals - you will have slightly unexpected behaviour, because of perl's handling of them See: perlipc . It's not impossible to use, but you need to be aware of the caveats involved.
But the root of the problem is - that the signal is handled safely, which means perl waits until a suitable moment to process it. It will not do this during a 'read' operation, so the signal processing will get deferred.
I think likely what is happening here is your ReadKey is not a nonblocking operation like you think it is. With reference to the Term::ReadKey manpage
ReadKey MODE [, Filehandle]
Takes an integer argument, which can currently be one of the following values:
0 Perform a normal read using getc
-1 Perform a non-blocked read
>0 Perform a timed read
So what it does instead is - starts reading from STDIN, and blocks (ignoring signals) until you press enter. At which point it runs your signal handler.
Given what you're trying to do here - I would suggest you don't want to use signals at all, and instead - just use a shared variable.
Something like this:
use threads;
use threads::shared;
use Term::ReadKey;
my $done : shared;
sub input_worker {
while ( not $done ) {
if ( defined( my $char = ReadKey( -1, *STDIN ) ) ) {
print "$char";
}
}
return;
} ## end sub input_worker
my $in_thr = threads->create( \&input_worker );
sleep 10;
$done++;
my $rc = $in_thr->join();
print "$rc\n";
Will terminate after the timeout, and because it's doing nonblocking reads, it'll bail out on time, without input. You should note though - this thread is going to be 'spinning' looping rapidly waiting to see if input has been pressed - so it's not very CPU efficient. (a small delay in the cycle helps immensely there, say 0.1s).
I have a perl program that takes over 13 hours to run. I think it could benefit from introducing multithreading but I have never done this before and I'm at a loss as to how to begin.
Here is my situation:
I have a directory of hundreds of text files. I loop through every file in the directory using a basic for loop and do some processing (text processing on the file itself, calling an outside program on the file, and compressing it). When complete I move on to the next file. I continue this way doing each file, one after the other, in a serial fashion. The files are completely independent from each other and the process returns no values (other than success/failure codes) so this seems like a good candidate for multithreading.
My questions:
How do I rewrite my basic loop to take advantage of threads? There appear to be several moduals for threading out there.
How do I control how many threads are currently running? If I have N cores available, how do I limit the number of threads to N or N - n?
Do I need to manage the thread count manually or will Perl do that for me?
Any advice would be much appreciated.
Since your threads are simply going to launch a process and wait for it to end, best to bypass the middlemen and just use processes. Unless you're on a Windows system, I'd recommend Parallel::ForkManager for your scenario.
use Parallel::ForkManager qw( );
use constant MAX_PROCESSES => ...;
my $pm = Parallel::ForkManager->new(MAX_PROCESSES);
my #qfns = ...;
for my $qfn (#qfns) {
my $pid = $pm->start and next;
exec("extprog", $qfn)
or die $!;
}
$pm->wait_all_children();
If you wanted you avoid using needless intermediary threads in Windows, you'd have to use something akin to the following:
use constant MAX_PROCESSES => ...;
my #qfns = ...;
my %children;
for my $qfn (#qfns) {
while (keys(%children) >= MAX_PROCESSES) {
my $pid = wait();
delete $children{$pid};
}
my $pid = system(1, "extprog", $qfn);
++$children{$pid};
}
while (keys(%children)) {
my $pid = wait();
delete $children{$pid};
}
Someone's given your a forking example. Forks aren't native on Windows, so I'd tend to prefer threading.
For the sake of completeness - here's a rough idea of how threading works (and IMO is one of the better approaches, rather than respawning threads).
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use Thread::Queue;
my $nthreads = 5;
my $process_q = Thread::Queue->new();
my $failed_q = Thread::Queue->new();
#this is a subroutine, but that runs 'as a thread'.
#when it starts, it inherits the program state 'as is'. E.g.
#the variable declarations above all apply - but changes to
#values within the program are 'thread local' unless the
#variable is defined as 'shared'.
#Behind the scenes - Thread::Queue are 'shared' arrays.
sub worker {
#NB - this will sit a loop indefinitely, until you close the queue.
#using $process_q -> end
#we do this once we've queued all the things we want to process
#and the sub completes and exits neatly.
#however if you _don't_ end it, this will sit waiting forever.
while ( my $server = $process_q->dequeue() ) {
chomp($server);
print threads->self()->tid() . ": pinging $server\n";
my $result = `/bin/ping -c 1 $server`;
if ($?) { $failed_q->enqueue($server) }
print $result;
}
}
#insert tasks into thread queue.
open( my $input_fh, "<", "server_list" ) or die $!;
$process_q->enqueue(<$input_fh>);
close($input_fh);
#we 'end' process_q - when we do, no more items may be inserted,
#and 'dequeue' returns 'undefined' when the queue is emptied.
#this means our worker threads (in their 'while' loop) will then exit.
$process_q->end();
#start some threads
for ( 1 .. $nthreads ) {
threads->create( \&worker );
}
#Wait for threads to all finish processing.
foreach my $thr ( threads->list() ) {
$thr->join();
}
#collate results. ('synchronise' operation)
while ( my $server = $failed_q->dequeue_nb() ) {
print "$server failed to ping\n";
}
If you need to move complicated data structures around, I'd recommend having a look at Storable - specifically freeze and thaw. These will let you shuffle around objects, hashes, arrays etc. easily in queues.
Note though - for any parallel processing option, you get good CPU utilisation, but you don't get more disk IO - that's often a limiting factor.
I have some code that spawns 5 threads of itself, at a time. I detach those threads, but have a shared variable $THREADCOUNT that I increment at the beginning of the subprocedure that is called by the thread call, and decrement at the end of the thread. When $THREADCOUNT equals 0, I spawn another 5 times.
The problem is, sometimes the thread exits unexpectedly and the $THREADCOUNT never makes it to 0, so the program stops. Is there someway to capture an exit like this and have $THREADCOUNT-- on unexpected exit?
Thanks so much. This is my first post so appologies if it's a little unclear.
Chris
Is the shared $THREADCOUNT variable really necessary? A call to threads->list(threads::running) will tell you whether any of your spawn are still running.
I can't figure out when anyone would ever want to use detach. I'd use something like
use threads;
my %workers;
sub start_worker {
my $thread = threads->create(#_);
$workers{$thread->tid} = $thread;
return $thread;
}
sub collect_finished_workers {
for my $thread (threads->list(threads::joinable)) {
$thread->join()
if delete($workers{$threads->tid}); # Don't assume we own all threads.
}
}
sub get_worker_count {
collect_finished_workers();
return 0+keys(%workers);
}
Note that this fixes the problem in your code where a thread isn't counted as started for a short while after it has started.