I am trying to implement multithread functionality perl script for more speed
I am trying to implement multithread functionality perl script for more speed
I need to know how to implement multithreading for the following perl code
#!/usr/bin/perl
use if $^O eq "MSWin32", Win32::Console::ANSI;
use Getopt::Long;
use HTTP::Request;
use LWP::UserAgent;
use IO::Select;
use HTTP::Headers;
use IO::Socket;
use HTTP::Response;
use Term::ANSIColor;
use HTTP::Request::Common qw(POST);
use HTTP::Request::Common qw(GET);
use URI::URL;
use IO::Socket::INET;
use Data::Dumper;
use LWP::Simple;
use LWP;
use URI;
use JSON qw( decode_json encode_json );
use threads;
my $ua = LWP::UserAgent->new;
$ua = LWP::UserAgent->new(keep_alive => 1);
$ua->agent("Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.31 (KHTML, like Gecko) Chrome/26.0.1410.63 Safari/537.31");
{
chomp($site);
push(#threads, threads->create (\&ask, \&baidu, $site));
sleep(1) while(scalar threads->list(threads::running) >= 50);
}
eval {
$_->join foreach #threads;
#threads = ();
};
########### ASK ###########
sub ask {
for ( $i = 0; $i < 20; $i += 1) {
my $url = "https://www.ask.com/web?o=0&l=dir&qo=pagination&q=site%3A*.fb.com+-www.fb.com&qsrc=998&page=$i";
my $request = $ua->get($url);
my $response = $request->content;
while( $response =~ m/((https?):\/\/([^"\>]*))/g ) {
my $link = $1;
my $site = URI->new($link)->host;
if ( $site =~ /$s/ ) {
if ( $site !~ /</ ) {
print "ask: $site\n";
}
}
}
}
}
########### Baidu ###########
sub baidu {
for ( my $ii = 10; $ii <= 760; $ii += 10 ) {
my $url = "https://www.baidu.com/s?pn=$ii&wd=site:fb.com&oq=site:fb.com";
my $request = $ua->get($url);
my $response = $request->content;
while ( $response =~ m/(style="text-decoration:none;">([^\/]*))/g ) {
my $site = $1;
$site =~ s/style="text-decoration:none;">//g;
if ( $site =~ /$s/ ) {
print "baidu: $site\n";
}
}
}
}
If run this code I get only Result from Ask.com.
How I can fix this problem and thanks for all ?
C:\Users\USER\Desktop>k.pl -d fb.com
ask: messenger.fb.com
ask: yourbusinessstory.fb.com
ask: research.fb.com
ask: communities.fb.com
ask: shemeansbusiness.fb.com
ask: nonprofits.fb.com
ask: messenger.fb.com
ask: yourbusinessstory.fb.com
ask: research.fb.com
ask: communities.fb.com
ask: shemeansbusiness.fb.com
ask: nonprofits.fb.com
ask: politics.fb.com
ask: communities.fb.com
ask: live.fb.com
ask: messenger.fb.com
ask: yourbusinessstory.fb.com
ask: research.fb.com
ask: communities.fb.com
ask: shemeansbusiness.fb.com
ask: nonprofits.fb.com
ask: politics.fb.com
ask: communities.fb.com
ask: live.fb.com
ask: techprep.fb.com
ask: newsroom.fb.com
ask: rightsmanager.fb.com ask: messenger.fb.com
ask: yourbusinessstory.fb.com
ask: research.fb.com
ask: communities.fb.com
ask: shemeansbusiness.fb.com
ask: nonprofits.fb.com
ask: politics.fb.com
ask: communities.fb.com
ask: live.fb.com
ask: messenger.fb.com
ask: yourbusinessstory.fb.com
ask: research.fb.com
ask: communities.fb.com
ask: shemeansbusiness.fb.com
ask: nonprofits.fb.com
ask: politics.fb.com
ask: communities.fb.com
ask: live.fb.com
ask: techprep.fb.com
ask: newsroom.fb.com
ask: rightsmanager.fb.com
ask: politics.fb.com
ask: communities.fb.com
ask: live.fb.com
ask: messenger.fb.com
ask: yourbusinessstory.fb.com
ask: research.fb.com
ask: communities.fb.com
ask: shemeansbusiness.fb.com
ask: nonprofits.fb.com
ask: politics.fb.com
ask: communities.fb.com
ask: live.fb.com
ask: techprep.fb.com
ask: newsroom.fb.com
ask: rightsmanager.fb.com
OK, so first off - there's some really quite icky looking things you're doing here, and I'd suggest you need to step back and review your code. It's looking a bit 'cargo-cult' thanks to things like:
use HTTP::Request::Common qw(POST);
use HTTP::Request::Common qw(GET);
Or:
my $ua = LWP::UserAgent->new;
$ua = LWP::UserAgent->new(keep_alive => 1);
... you're creating a new LWP::UserAgent instance, and then ... creating another one with a different parameter.
You've also got a load of errors that you're not seeing because you didn't include the most important use items:
use strict;
use warnings qw ( all );
Turn these on first, and then fix the errors.
But here for example:
push(#threads, threads->create (\&ask, \&baidu, $site));
What do you think this line is supposed to do? Because what's actually happening here is you try and invoke the ask sub, and then pass it arguments of a code reference to baidu sub, and a string $site - which is undefined at this point in the code. But that's academic, because you NEVER READ THEM in your subroutine.
So it's not really a surprise your code isn't really working - it's nonsense.
But that aside - perls threading model is often misunderstood. It is not a lightweight thread like you might be thinking of in other programming languages - actually it's rather heavyweight.
You're creating and spawning a thread per iteration, and that's not very efficient either.
What you really want to be doing is using Thread::Queue.
Spawn a small number of 'worker' threads per task, have them read from the queue, and do their work individually.
end the queue when it's done with, and let the threads exit and be reaped by the main process.
Something like in this answer: Perl daemonize with child daemons
... but are you sure there isn't a module that does what you want anyway?
Related
I have a trouble in running a Perl script in muti-threads. It continued consume memory and finally the system ran out of memory and killed it. It seems that the sub-threads were detached but the system resource were not released when they finished. I am pretty new to Perl and couldn't find which part went wrong. This is part of the script that may cause this problem. Could anyone help me with this?
use strict;
use warnings;
print "different number:\t";
my $num1=<>;
chomp $num1;
if($num1!~/[1 2 3 4 5]/)
{
print "invalid input number\n";
END;
}
my $i=0;
my $no;
my #spacer1;
my $nn;
my #spacer2;
open IN,"file1.txt"or die"$!";
while(<IN>)
{
chomp;
if($_=~ /^>((\d)+)\|((\d)+)/)
{
$no=$1;
$spacer1[$no][0]=$3;
}
else
{
$spacer1[$no][1]=$_;
}
}
close IN;
open IN, "file2.txt" or die "$!";
while(<IN>)
{
chomp;
if($_=~ /^>((\d)+)\|((\d)+)/)
{
$nn=$1;
$spacer2[$nn][0]=$3;
}
else
{
$spacer2[$nn][1]=$_;
}
}
close IN;
#-----------------------------------------------------------------#create threads
use subs qw(sg_ana);
use threads;
use Thread::Semaphore;
my $cycl=(int($no/10000))+1;
my $c;
my #thd;
my $thread_limit= Thread::Semaphore -> new (3);
foreach $c(1..$cycl)
{
$thread_limit->down();
$thd[$c]=threads->create("sg_ana",$c-1,$c,$num1);
$thd[$c]->detach();
}
&waitquit;
#-------------------------------------------------------------#limite threads num
sub waitquit
{
print "waiting\n";
my $num=0;
while($num<3)
{
$thread_limit->down();
$num++;
}
}
#---------------------------------------------------------------#alignment
my $n;
my $n1;
my $j;
my $k;
my $l;
my $m;
my $num;#number of match
my $num2=0;;#arrange num
sub sg_ana
{
my $c1=shift;
my $c2=shift;
$num1=shift;
open OUT,">$num1.$c2.txt" or die "$!";
if($num1==1)
{
foreach $n($c1*10000..$c2*10000-1)
{
if($spacer2[$n][1])
{
my $presult1;
my $presult2;
$num2=-1;
foreach $i(0..19)
{
$num=0;
$num2++;
my $tmp1=(substr $spacer2[$n][1],0,$i)."\\"."w".(substr $spacer2[$n][1],$i+1,19-$i);
foreach $n1(0..#spacer1-1)
{
if($spacer1[$n1][1])
{
my $tmp2=substr $spacer1[$n1][1],0,20;
if($tmp2=~/$tmp1/)
{
$num++;
$presult1.=$n1.",";
}
}
}
$presult2=$i+1;
if($num>=4)
{
print OUT "\n";
}
}
}
}
}
close OUT;
$thread_limit->up();
}
Rule one of debugging perl is enable use strict; and use
warnings; and then sort out the errors. Actually, you should
probably do that first of all, before you even start writing code.
You're creating and limiting threads via a Semaphore - but actually
this is really inefficient because of how perl does threads - they
aren't lightweight, so spawning loads is a bad idea. A better way of doing this is via Thread::Queue a bit like this.
Please use 3 arg open and lexical file handles. e.g. open ( my
$out, '>', "$num.$c2.txt" ) or die $!;. You're probably getting
away with it here, but you have got OUT as a global namespace
variable being used by multiple threads. That way lies dragons.
Don't use single letter variables. And given how you you use $c
then you'd be far better off:
foreach my $value ( 1..$cycl ) {
## do stuff
}
The same is true of all your other single letter variables though - they're not meaningful.
You pass $num before it's initialised, so it's always going to
be undef within your sub. So your actual subroutine is just:
sub sg_ana
{
my $c1=shift;
my $c2=shift;
$num1=shift;
open OUT,">$num1.$c2.txt" or die "$!";
close OUT;
$semaphore->up();
}
Looking at it - I think you may be trying to do something with a shared variable there, but you're not actually sharing it. I can't decode the logic of your program though (thanks to having a load of single letter variables most likely) so I can't say for sure.
You're calling a subroutine &waitquit;. That's not good style -
prefixing with an ampersand and supplying no arguments does
something subtly different to just invoking the sub 'normally' - so
you should avoid it.
Don't instantiate your semaphore like this:
my $semaphore=new Thread::Semaphore(3);
That's an indirect procedure call, and bad style. It would be better written as:
my $thread_limit = Thread::Semaphore -> new ( 3 );
I would suggest rather than using Semaphores like that, you'd be far better off not detatching your threads, and just using join. You also don't need an array of threads - threads -> list does that for you.
I can't reproduce your problem, because your sub isn't doing
anything. Have you by any chance modified it for posting? But a classic reason for perl memory exhaustion when threading is because each thread clones the parent process - and so 100 threads is 100x the memory.
I have a code similar to the below. I have one main script which is calling another module named initial.pm. initial.pm opens up connection with an AMQP server (In my case RabbitMQ)and using Net::AMQP::RabbitMQ library for establishing the connection. Everything works fine except when I try to join my threads I get segmentation fault.
I think the Net::AMQP::RabbitMQ is not thread safe. But this is only being used by the main thread. Im pretty sure you can reproduce the error if you just copy and past the codes below.
How do I fix it ?
main.pl
#!/usr/bin/perl
use Cwd qw/realpath/;
use File::Basename qw/dirname/;
use lib 'lib';
use threads;
use threads::shared;
use initial;
my #threads = ();
my $run :shared = 1;
my $init = load initial($name);
$SIG{'TERM'} = sub {
$run = 0;
};
threads->create(\&proc1);
threads->create(\&proc2);
while($run){
sleep(1);
print "I am main thread\n";
}
$_->join() for threads->list();
sub proc1 {
while($run){
sleep(1);
print "I am child thread 1 \n"
}
}
sub proc2 {
while($run){
sleep(1);
print "I am child thread 2 \n";
}
}
lib/initial.pm
package initial;
use Net::AMQP::RabbitMQ;
use Cwd qw/realpath/;
use File::Basename qw/dirname/;
my $mq;
my $stop = 0;
sub load {
my $class = shift;
my $self = {};
connectq();
bless $self,$class;
return $self;
}
sub connectq {
$mq = Net::AMQP::RabbitMQ->new();
my ($host,$port,$user,$pass) = ('localhost','5672','guest','guest');
$mq->connect($host, {
user => $user,
password => $pass,
port => $port,
timeout => 10,
});
$mq->channel_open(1);
$mq->consume(1, 'logger');
}
1;
I can't reproduce your problem directly, because I don't have the library installed.
One way of 'faking' thread safety in a not-thread-safe module is to rescope your 'use' to only the bit where you'll be using it.
You see, when you start a thread, it copies the program state - loaded libraries and everything.
If your run (something like):
#!/usr/bin/env perl
use strict;
use warnings;
use XML::Twig;
use Data::Dumper;
sub thread1 {
print threads->self->tid.": Includes:", Dumper \%INC,"\n";
}
#main;
print "Main includes:", Dumper \%INC,"\n";
threads -> create ( \&thread1 );
You'll see XML::Twig is loaded in both. If the process of 'loading' the module causes some state changes (and it can) then you immediately have a potential thread-safety issue.
However if you instead do:
#!/usr/bin/env perl
use strict;
use warnings;
use threads;
use Data::Dumper;
sub thread1 {
require XML::Twig;
XML::Twig -> import;
print threads->self->tid.": Includes:", Dumper (\%INC),"\n";
}
#main;
print "Main includes:", Dumper (\%INC),"\n";
threads -> create ( \&thread1 );
foreach my $thr ( threads -> list ) {
$thr -> join;
}
You effectively cause the module to be dynamically loaded within the thread - the module is only present in one 'code instance' so you are much less likely to be tripped up by 'thread safety' issues.
Alternatively - forking instead of threading ... might be an alternative. This has slightly different 'safety' problems.
But there really is no way to avoid this. Even with shared variables, the core problem is - when you thread, bits of code happen in a different order. There's all sorts of fruity things that can happen as a result. A shared var is one way of ensuring it's the same variable being checked each time - e.g. share $init, but that may well make things worse, because you're then potentially trampling over the same instance/sockets with different threads.
You can, however, reduce the 'thread safety' problem to a limited scope, and use e.g. Thread::Queue to pass messages to/from your 'module user' thread.
I'm learning how to do threading in Perl. I was going over the example code here and adapted the solution code slightly:
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use Thread::Semaphore;
my $sem = Thread::Semaphore->new(2); # max 2 threads
my #names = ("Kaku", "Tyson", "Dawkins", "Hawking", "Goswami", "Nye");
my #threads = map {
# request a thread slot, waiting if none are available:
foreach my $whiz (#names) {
$sem->down;
threads->create(\&mySubName, $whiz);
}
} #names;
sub mySubName {
return "Hello Dr. " . $_[0] . "\n";
# release slot:
$sem->up;
}
foreach my $t (#threads) {
my $hello = $t->join();
print "$hello";
}
Of course, this is now completely broken and does not work. It results in this error:
C:\scripts\perl\sandbox>threaded.pl
Can't call method "join" without a package or object reference at C:\scripts\perl\sandbox\threaded.pl line 24.
Perl exited with active threads:
0 running and unjoined
9 finished and unjoined
0 running and detached
My objective was two-fold:
Enforce max number of threads allowed at any given time
Provide the array of 'work' for the threads to consume
In the original solution, I noticed that the 0..100; code seems to specify the amount of 'work' given to the threads. However, in my case where I want to supply an array of work, do I still need to supply something similar?
Any guidance and corrections very welcome.
You're storing the result of foreach into #threads rather than the result of threads->create.
Even if you fix this, you collect completed threads too late. I'm not sure how big of a problem that is, but it might prevent more than 64 threads from being started on some systems. (64 is the max number of threads a program can have at a time on some systems.)
A better approach is to reuse your threads. This solves both of your problems and avoids the overhead of repeatedly creating threads.
use threads;
use Thread::Queue 3.01 qw( );
use constant NUM_WORKERS => 2;
sub work {
my ($job) = #_;
...
}
{
my $q = Thread::Queue->new();
for (1..NUM_WORKERS) {
async {
while (my $job = $q->dequeue()) {
work($job);
}
};
}
$q->enqueue(#names); # Can be done over time.
$q->end(); # When you're done adding.
$_->join() for threads->list();
}
I have got easy Perl script where I have got a BIG loop and inside this I invoke more or less million times function my_fun(). I would like to create pool of threads which will be dealing with it - max 5 threads in this same time will be invoking this method in loop.
It is really important for me to use the fastest library - It will be really nice to see examples.
My code looks like this:
for (my $i = 0; $i < 1000000 ; $i++) {
my_fun();
}
Thank you in advance
Have a look at Parallel::ForkManager. It's using fork, not threads, but it should get your job done very simply.
Example lifted from the docs and slightly altered:
use Parallel::ForkManager;
my $pm = Parallel::ForkManager->new(5); # number of parallel processes
for my $i (0 .. 999999) {
# Forks and returns the pid for the child:
my $pid = $pm->start and next;
#... do some work with $data in the child process ...
my_fun();
$pm->finish; # Terminates the child process
}
$pm->wait_all_children;
We can't give you the fastest way, since that depends on the work, and you didn't tell us what the work is.
But you did ask about threads, so I'll give you the foundation of a threaded application. Here is a worker model. It's robust, maintainable and extendable.
use threads;
use Thread::Queue qw( ); # Version 3.01+ required
my $NUM_WORKERS = 5;
sub worker {
my ($job) = #_;
...
}
my $q = Thread::Queue->new();
my #workers;
for (1..$NUM_WORKERS) {
push #workers, async {
while (defined(my $job = $q->dequeue())) {
worker($job);
}
};
}
$q->enqueue($_) for #jobs; # Send work
$q->end(); # Tell workers they're done.
$_->join() for #workers; # Wait for the workers to finish.
This is a basic flow (one-directional), but it's easy to make bi-directional by adding a response queue.
This uses actual threads, but you can switch to using processes by switching use threads; to use forks;.
Parallel::ForkManager can also be used to provide a worker model, but it's continually creating new processes instead of reusing them. This does allow it to handle child death easily, though.
Ref: Thread::Queue (or Thread::Queue::Any)
Take a look at the threads documentation.
I just introduced threads to a Perl program, where one of its modules was using Memoize.
I'm getting this error message:
Thread 1 terminated abnormally: Anonymous function called in forbidden scalar context; faulting
The error occurs if I have both threads and Memoize, but will disappear if I take away one of these elements. But the problem isn't because Memoize isn't thread-safe - in my code, all the memoization happens within the same thread.
Is this a bug with Memoize? Is there a way I can work around this? Otherwise I'm going to get rid of Memoize.
Here's some sample code to isolate the problem:
use strict;
use warnings;
use threads;
use Thread::Semaphore;
use Memoize;
my $semaphore = Thread::Semaphore->new;
memoize('foo');
sub foo {
return shift;
}
sub invoke_foo {
$semaphore->down; # ensure memoization is thread-safe
my $result = foo(#_);
$semaphore->up;
return $result;
}
my #threads;
foreach (1 .. 5) {
my $t = threads->create( sub { invoke_foo($_) });
push #threads, $t;
}
$_->join foreach #threads;
Memoize stores the caches for every memoized function in one hash (instead of using a closure). It uses the address of the function as the index into that hash.
The problem is that the address of the function changes when it's cloned into a new thread. (Add print(\&foo, "\n"); in invoke_foo.). It's a bug in Memoize.
Workaround: Load the memoised module from within the threads. the following simulates (the relevant aspects of) that:
use strict;
use warnings;
use threads;
use Memoize;
sub foo {
return shift;
}
sub invoke_foo {
return foo(#_);
}
my #threads;
foreach (1 .. 5) {
my $t = threads->create( sub {
memoize('foo');
invoke_foo($_);
});
push #threads, $t;
}
$_->join foreach #threads;
By the way, each thread has its own cache. that could also be considered a bug.
As noted, Memoize is not thread aware. If you want per thread memoization, ikegami's restructuring will work well. If instead you want global memoization, then replacing Memoize with something like the following could work:
use strict;
use warnings;
use 5.010;
use threads;
use threads::shared;
sub memoize_shared {
my $name = shift;
my $glob = do {
no strict 'refs';
\*{(caller)."::$name"}
};
my $code = \&$glob;
my $sep = $;;
my (%scalar, %list) :shared;
no warnings 'redefine';
*$glob = sub {
my $arg = join $sep => #_;
if (wantarray) {
#{$list{$arg} ||= sub {\#_}->(&$code)}
}
else {
exists $scalar{$arg}
? $scalar{$arg}
:($scalar{$arg} = &$code)
}
}
}
and to use it:
sub foo {
my $x = shift;
say "foo called with '$x'";
"foo($x)"
}
memoize_shared 'foo';
for my $t (1 .. 4) {
threads->create(sub {
my $x = foo 'bar';
say "thread $t got $x"
})->join
}
which prints:
foo called with 'bar'
thread 1 got foo(bar)
thread 2 got foo(bar)
thread 3 got foo(bar)
thread 4 got foo(bar)
The memoize_shared function above is fairly complicated because it deals with propegating list and scalar contexts as well as replacing the named subroutine. It is sometimes easier to just build the memoziation into the target subroutine:
{my %cache :shared;
sub foo {
my $x = shift;
if (exists $cache{$x}) {$cache{$x}}
else {
say "foo called with '$x'";
$cache{$x} = "foo($x)"
}
}}
Building the memoization into the subroutine does make it a bit more complicated, but it will be faster than using a wrapper function like memoize. And it gives you exact control over how to memoize the subroutine, including things like using a threads::shared cache.
Memoize should work under threads, albeit a bit slower:
"There is some problem with the way goto &f works under threaded Perl, perhaps because of the lexical scoping of #_. This is a bug in
Perl, and until it is resolved, memoized functions will see a slightly
different caller() and will perform a little more slowly on threaded
perls than unthreaded perls."