I want to use threads with mod_perl,
as a sample I use following script:
use strict;
use warnings;
use threads;
sub doOperation{
my $vr = $_[0];
my $i = 0;
while($i < 10000000){
$i++
}
print "Thread done! var1 = $vr\n";
threads->exit();
}
my #thr;
$thr[0] = threads->create(\&doOperation,5);
$thr[1] = threads->create(\&doOperation,6);
foreach(#thr){ $_->join(); }
I works smooth using CLI:
# perl multithr.pl
Thread done! var1 = 6
Thread done! var1 = 5
However if run it through Apache mod_perl module it causes Segmentation fault error.
My Environment:
CentOS-6.5 x86_64
httpd-2.2.15
mod_perl-2.0.4
threads->exit();
This statement raised Segmentation fault error. Exit thread properly!
Related
I write perl script to do a certain but I needed to mutlithread it, but I get this:
Perl exited with active threads:
2 running and unjoined
0 finished and unjoined
0 running and detached
Here is the code:
use Net::Ping;
use threads;
use Benchmark qw(:hireswallclock);
use threads::shared;
my $starttime = Benchmark->new;
my $finishtime;
my $timespent;
my $num_of_threads = 2;
my #threads = initThreads();
my $inFile = $ARGV[0] ;
open(IN , "<$inFile") or die "can not find $inFile" ;
my #output: shared = <IN>;
chomp (#output) ;
my $chunk_size = #output / 2;
print($chunk_size);
#############################
######## PROCEDURES ########
#############################
# Subroutine that intializes an array that will contain all our threads:
sub initThreads{
my #initThreads; # Our array
for(my $i=1; $i<=$num_of_threads; $i++){
push(#initThreads, $i);
}
return #initThreads;
}
sub doScript{
my $id = threads->tid();
print "//////////////////////////////////////////////////////////////////////////////////////////////Starting thread $id\n";
my ($start, $end, $output) = #_;
for my $i ($start .. $end) {
## some stuff done
sleep 1 if 0.2 > rand;
}
print "/////////////////////////////////////////////////////////////////////////////////////////////////////////////////Thread $id done!\n";
threads->exit();
}
########################
######## MAIN ########----------------------------------------------------------------
########################
for my $chunk(1 .. 2){
my $start = ($chunk - 1) * $chunk_size;
push #threads, threads->create(
\&doScript,
$start,
($start + $chunk_size - 1),
\#output,
);
print("finish");
}
# This tells the main program to keep running until all threads have finished.
foreach(#threads){
threads->join();
}
$finishtime = Benchmark->new;
$timespent = timediff($finishtime,$starttime);
print "\nDone!\nSpent ". timestr($timespent);
#print "\nProgram Done!\nPress Enter to exit\n";
$a = <>;
close (IN);
I even replaced the join block with this:
$_->join() for threads->list();
the error was solved but the script seemed not to do anything, threads started and terminated without doing anything.
Can anyone help me with this !
The reason you get that error is exactly as said on the tin - your code exited before the threads were closed. It can commonly happen when an exit or die is triggered early.
In particular I think your problem may lie within your reusing of #threads and initThreads().
The latter returns a list of numbers, not any threads. And then you push a couple more threads to the end of the list later, when you're doing a create.
That looks a lot like some sort of logic error to me.
But the major problem I think will be this:
foreach(#threads){
threads->join();
}
You're not actually joining a specific thread. What you probably want is:
foreach my $thr ( #threads ) {
$thr -> join();
}
At least, you would, if you hadn't manually populated #threads with [1,2] thanks to my #threads = initThreads();
In perl, I have some code like
my $enter = `curl -s -m 10 http://URL`;
How would I use threading to run this function 10 times at once?
I found this but I am not sure how to use it to set a specific amount of threads
Edit: I guess I misunderstood what Threads::Queue was doing. My original question still stands for simultaneously running multiple commands at once.
You can use fork(). In this example, I use the Parallel::ForkManager module. $max_forks is the number of processes to run simultaneously (set to two for an example), and you'd put your system/curl code after ### add curl logic here, and remove the print() and sleep() example statements from there as well.
#!/usr/bin/perl
use warnings;
use strict;
use Parallel::ForkManager;
my $max_forks = 2;
my $fork = new Parallel::ForkManager($max_forks);
my #urls = (
'http://perlmonks.org',
'http://stackoverflow.com',
'http://slashdot.org',
'http://wired.com',
);
# on start callback
$fork->run_on_start(
sub {
my $pid = shift;
print "Starting PID $pid\n";
}
);
# on finish callback
$fork->run_on_finish(
sub {
my ( $pid, $exit, $ident, $signal, $core) = #_;
if ($core){
print "PID $pid core dumped.\n";
}
else {
print "PID $pid exited with exit code $exit " .
" and signal $signal\n";
}
}
);
# forking code
for my $url (#urls){
$fork->start and next;
### add curl logic here
print "$url\n";
sleep(2);
$fork->finish;
}
$fork->wait_all_children;
I am using Thread::Queue to push an array onto a queue and process each element of it using threads. Below is a simplified version of my program to demonstrate what is happening.
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Queue;
# Define queue
my $QUEUE :shared = new Thread::Queue();
# Define values
my #values = qw(string1 string2 string3);
# Enqueue values
$QUEUE->enqueue(#values);
# Get thread limit
my $QUEUE_SIZE = $QUEUE->pending();
my $thread_limit = $QUEUE_SIZE;
# Create threads
for my $i (1 .. $thread_limit) {
my $thread = threads->create(\&work);
}
# Join threads
my $i = 0;
for my $thread (threads->list()) {
$thread->join();
}
print "COMPLETE\n";
# Thread work function
sub work {
while (my $value = $QUEUE->dequeue()) {
print "VALUE: $value\n";
sleep(5);
print "Finished sleeping\n";
}
print "Got out of loop\n";
}
When I run this code I get the following output and then it just hangs forever:
VALUE: string1
VALUE: string2
VALUE: string3
Finished sleeping
Finished sleeping
Finished sleeping
Once the queue reaches its end, the while loop should break and the script should continue but it doesn't appear to ever get out of the loop.
Why is this getting stuck?
Since you never call $QUEUE->end(), your threads are blocking on dequeue() waiting for more entries to appear.
So, ensure you do call $QUEUE->end() after the last call to enqueue, or before joining the threads.
Hi I am trying to stop or kill the thread $t2 when $t1 stops. Here is the code:
#!/usr/local/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;
use Time::HiRes qw( sleep );
print "Starting main program\n";
my #threads;
my $t1 = threads->new(\&c1);
my $t2 = threads->new(\&progress);
#my $t2 = threads->new(\&c2);
push(#threads,$t1);
push(#threads,$t2);
my $ret1 = $t1->join();
print "Thread returned: $ret1\n";
$t2->join();
if (!($t1->is_running()))
{
$t2->exit();
}
print "End of main program\n";
sub c1
{
print "Inside thread 1\n";
sleep 5;
return 245;
}
sub c2
{
print "Inside thread 2\n";
}
sub progress
{
$| = 1; # Disable buffering on STDOUT.
my $BACKSPACE = chr(0x08);
my #seq = qw( | / - \ );
for (;;) {
print $seq[0];
push #seq, shift #seq;
sleep 0.200;
print $BACKSPACE;
}
print "$BACKSPACE $BACKSPACE";
}
But thread $t2 continues running. Please help me out with this.
How to kill thread $t2.
I am confused with join(), detach(), exit()
You can't call exit on thread instance $t2->exit() and module warns you about that,
perl -Mthreads -we '$_->exit(3) and $_->join for async {sleep 4}'
Usage: threads->exit(status) at -e line 1
Perl exited with active threads:
1 running and unjoined
0 finished and unjoined
0 running and detached
However, you can send a signal to thread (check signal list)
# Send a signal to a thread
$thr->kill('SIGUSR1');
You can use a shared variable:
use threads::shared;
my $done : shared;
$done = 0;
my $t1 = threads->new( sub { c1(); $done = 1;} );
And in the progress function:
# ...
for (;!$done;) {
# ....
While I see how to have Perl trap Ctrl-C (sigint) in bash; I'm getting lost at why does it fail with threads; I'm trying the following script:
#!/usr/bin/env perl
use threads;
use threads::shared; # for shared variables
my $cnt :shared = 0;
sub counter() {
while (1) {
$cnt++;
print "thread: $cnt \n";
sleep 1;
}
}
sub finisher{
### Thread exit! ...
print "IIII";
threads->exit();
die;
};
# any of these will cause stop of reaction to Ctrl-C
$SIG{INT} = \&finisher;
$SIG{INT} = sub {print "EEE\n" ;} ;
$SIG{INT} = 'IGNORE';
# setting to DEFAULT, brings usual behavior back
#~ $SIG{INT} = 'DEFAULT';
my $mthr = threads->create(\&counter);
$mthr->join();
... and as soon as the SIGINT handler is set to anything else than the default (where Ctrl-C causes exit), it basically causes for the script to stop reacting on Ctrl-C any longer:
$ ./test.pl
thread: 1
^Cthread: 2
^C^Cthread: 3
^C^C^C^Cthread: 4
thread: 5
thread: 6
thread: 7
thread: 8
Terminated
... and I have to sudo killall perl in order to terminate the script.
There is a bit on threads and Ctrl-C in these links:
Sending sig INT ( control C ) to threads - Dev Shed
SOLVED: Is this a bug of perl threads ? - Perl Monks
How do we capture CTRL ^ C - Perl Monks
Is the signal handler supposed to work like this?
... but I cannot say if it conclusively answers whether "capturing" Ctrl-C under perl in bash is definitely impossible?
Thanks in advance for any answers,
Cheers!
Ok, I think I got it (but I'm leaving the previous entry (below) for reference ...)
The trick turns out to be that, from the main SIGINT handler, one must signal the thread via kill - AND then thread also needs to have a separate SIGINT handler (from the first link in OP); AND instead of just join(), one needs to use the code in the answer by #ikegami:
#!/usr/bin/env perl
use threads;
use threads::shared; # for shared variables
my $cnt :shared = 0;
my $toexit :shared = 0;
sub counter() {
$SIG{'INT'} = sub { print "Thread exit\n"; threads->exit(); };
my $lexit = 0;
while (not($lexit)) {
{ lock($toexit);
$lexit = $toexit;
}
$cnt++;
print "thread: $cnt \n";
sleep 1;
}
print "out\n";
}
my $mthr;
sub finisher{
{ lock($toexit);
$toexit = 1;
}
$mthr->kill('INT');
};
$SIG{INT} = \&finisher;
$mthr = threads->create(\&counter);
print "prejoin\n";
#~ $mthr->join();
while (threads->list()) {
my #joinable = threads->list(threads::joinable);
if (#joinable) {
$_->join for #joinable;
} else {
sleep(0.050);
}
}
print "postjoin\n";
I may be overkilling it with the $toexit there, but at least now this is the result:
$ ./test.pl
prejoin
thread: 1
thread: 2
thread: 3
^CThread exit
postjoin
Many thanks to all for the solution :)
Cheers!
Thanks to the suggestion by #mob for PERL_SIGNALS to unsafe (note, Perl 5.14 does not allow "internal" setting of $ENV{'PERL_SIGNALS'}), I'm getting somewhere - now Ctrl-C is detected - but it either terminates with a segfault, or with error:
#!/usr/bin/env perl
use threads;
use threads::shared; # for shared variables
my $cnt :shared = 0;
my $toexit :shared = 0;
sub counter() {
my $lexit = 0;
while (not($lexit)) {
{ lock($toexit);
$lexit = $toexit;
}
$cnt++;
print "thread: $cnt \n";
sleep 1;
}
print "out\n";
#~ threads->detach(); # Thread 1 terminated abnormally: Cannot detach a joined thread
#~ exit;
}
my $mthr;
# [http://code.activestate.com/lists/perl5-porters/164923/ [perl #92246] Perl 5.14 does not allow "internal" setting of $ENV ...]
sub finisher{
### Thread exit! ...
#~ print "IIII";
# anything here results with: Perl exited with active threads:
#~ threads->exit();
#~ threads->join();
#~ $mthr->exit();
#~ $mthr->join();
#~ $mthr->detach();
#~ $mthr->kill();
#~ threads->exit() if threads->can('exit'); # Thread friendly
#~ die;
{ lock($toexit);
$toexit = 1;
}
#~ threads->join(); #
};
# any of these will cause stop of reaction to Ctrl-C
$SIG{INT} = \&finisher;
#~ $SIG{INT} = sub {print "EEE\n" ; die; } ;
#~ $SIG{INT} = 'IGNORE';
# setting to DEFAULT, brings usual behavior back
#~ $SIG{INT} = 'DEFAULT';
$mthr = threads->create(\&counter);
print "prejoin\n";
$mthr->join();
print "postjoin\n";
With the comments as above, that code react with:
$ PERL_SIGNALS="unsafe" ./testloop06.pl
prejoin
thread: 1
thread: 2
thread: 3
^Cthread: 4
out
Segmentation fault
Result is the same if I add the following that uses Perl::Signals::Unsafe:
$mthr = threads->create(\&counter);
UNSAFE_SIGNALS {
$mthr->join();
};
Almost there, hopefully someone can chime in ... :)
Signal handlers are only called between Perl opcodes. Your code is blocked in $mthr->join();, so it never gets to handle the signal.
Possible solution:
use Time::HiRes qw( sleep );
# Interruptable << $_->join() for threads->list; >>
while (threads->list()) {
my #joinable = threads->list(threads::joinable);
if (#joinable) {
$_->join for #joinable;
} else {
sleep(0.050);
}
}