Perl并行搜寻器多线程

Question

我有一个多线程Perl搜寻器，如果我在数组中声明URL，则可以正常工作。但是，如果我从DB中读取URL，则会收到“分段失败”错误。请帮助我解决此问题。谢谢

直接网址声明

use 5.012; use warnings;
use threads;
use Thread::Queue;
use LWP::UserAgent;

use constant THREADS => 10;

my $queue = Thread::Queue->new();
my @URLs =qw(http://www.example.com
http://www.example.com1
http://www.example.com2 );

print @URLs;
my @threads;

for (1..THREADS) {
    push @threads, threads->create(sub {
        my $ua = LWP::UserAgent->new;
        $ua->timeout(5); # short timeout for easy testing.
        while(my $task = $queue->dequeue) {
            my $response = eval{ $ua->get($task)->status_line };
            say "$task --> $response";
        }
    });
}

$queue->enqueue(@URLs);
$queue->enqueue(undef) for 1..THREADS;
# ... here work is done
$_->join foreach @threads;

尝试从数据库读取URL

my $dbh = DBI->connect("DBI:mysql:$database;host=$server", $username, $password) # Get the rows from database
    || die "Could not connect to database: $DBI::errstr";

my $sth = $dbh->prepare('select cname,url,xpath,region from competitors')    #query to select required fields
    || die "$DBI::errstr";

$sth->execute();

if ($sth->rows < 0) {
    print "Sorry, no domains found.\n";
}
else {                                                
    while (my $results = $sth->fetchrow_hashref) {
        my $competitor= $results->{cname};                      
        my $url = $results->{url};                         
        my $xpath = $results->{xpath};
        my $region = $results->{region};

        push(my @all,$url);   

        use constant THREADS => 10;
        my $queue = Thread::Queue->new();
        my @URLs=@all;
        my @threads;

        for (1..THREADS) {
            push @threads, threads->create(sub {
                my $ua = LWP::UserAgent->new;
                $ua->timeout(500); # short timeout for easy testing.
                while(my $task = $queue->dequeue) {
                    my $response = eval{ $ua->get($task)->status_line };
                    print  "$task --> $response";
                }
            });
        }

        $queue->enqueue( @URLs);
        $queue->enqueue(undef) for 1..THREADS;
        # ... here work is done
        $_->join foreach @threads;
    }

}  #close db

$sth->finish;
$dbh->disconnect;

预期o / p

www.example.com-->200 ok

www.example.com1-->200 ok

当前输出

细分错误

Answer 1

当您创建线程并创建它们的副本时， $sth和$dbh仍然存在，这是不可以的 。

新创建的线程必须建立自己的数据库连接。 句柄不能在线程之间共享。

更好地定义变量范围可以避免此问题。

use strict;
use warnings;
use threads;
use Thread::Queue 3.01 qw( );

use constant NUM_WORKERS => 10;

sub worker {
   my ($ua, $url) = @_;
   ...
}

{
   my $q = Thread::Queue->new();

   for (1..NUM_WORKERS) {
      async {
         my $ua = LWP::UserAgent->new();
         while ( my $url = $q->dequeue() ) {
            eval { worker($ua, $url); 1 }
               or warn $@;
         }
      };
   }

   {
      my $dbh = DBI->connect(..., { RaiseError => 1 });
      my $sth = $dbh->prepare('SELECT ...');
      $sth->execute();
      while ( my $row = $sth->fetchrow_hashref() ) {
         $q->enqueue($row->{url});
      }
   }

   $q->end();
   $_->join for threads->list;
}

Answer 2

您应该在while循环之外声明@all，然后，在推送URL时，关闭该循环并继续

my $dbh = DBI->connect("DBI:mysql:$database;host=$server", $username, $password) # Get the rows from database
    || die "Could not connect to database: $DBI::errstr";

my $sth = $dbh->prepare('select cname,url,xpath,region from competitors')    #query to select required fields
    || die "$DBI::errstr";

$sth->execute();

# >> declare your URL-array before starting to fetch
my @URLs;
if ($sth->rows < 0) {
    print "Sorry, no domains found.\n";
}

else {


    while (my $results = $sth->fetchrow_hashref) {
        my $competitor= $results->{cname};                      
        my $url = $results->{url};                         
        my $xpath = $results->{xpath};
        my $region = $results->{region};

        push(@URLs,$url);   
    }

}  

$sth->finish;
$dbh->disconnect;

use constant THREADS => 10;
my $queue = Thread::Queue->new();
my @threads;

for (1..THREADS) {
        push @threads, threads->create(sub {
        my $ua = LWP::UserAgent->new;
        $ua->timeout(500); # short timeout for easy testing.
        while(my $task = $queue->dequeue) {
            my $response = eval{ $ua->get($task)->status_line };
            print  "$task --> $response";
        }
    });
}

$queue->enqueue( @URLs);
$queue->enqueue(undef) for 1..THREADS;
# ... here work is done
$_->join foreach @threads;

Answer 3

由于perl代码的缘故，段错误非常罕见。 它们与内存有关， 通常意味着外部二进制文件有问题。 （我在这里押注DBI）

特别是线程有很多遗留问题-尽管在更新版本的perl中它们变得越来越好。 我强烈建议您考虑将Perl升级到最新版本。 我知道这并不总是一种选择，但这是一个好主意。

由于您没有数据库，因此很难再猜测您的问题，所以我无法重新创建它。

我建议通常可以做一些事情来使线程保持“干净”-代码的工作方式是数据库句柄在线程范围内。 我会避免这样做。 在顶部声明线程子，并尽可能缩小范围。

我会注意：

push ( my @all, $url ); 

可能没有按照您的想法做！

但是，是的，以您的代码为例：

#!/usr/bin/perl
use strict;
use warnings;

use threads;
use Thread::Queue;
use LWP;

my $num_threads = 10;

my $work_q = Thread::Queue->new();

sub worker {
    my $ua = LWP::UserAgent->new;
    $ua->timeout(500);    # short timeout for easy testing.
    while ( my $task = $work_q->dequeue ) {
        my $response = eval { $ua->get($task)->status_line };
        print "$task --> $response";
    }
}


## fetch_list

sub fetch_url_list {
    my $dbh = DBI->connect( "DBI:mysql:$database;host=$server",
        $username, $password )    # Get the rows from database
        || die "Could not connect to database: $DBI::errstr";

    my $sth =
        $dbh->prepare( 'select cname,url,xpath,region from competitors'
        )                         #query to select required fields
        || die "$DBI::errstr";

    $sth->execute();


    if ( $sth->rows < 0 ) {
        print "Sorry, no domains found.\n";
    }
    else {
        while ( my $results = $sth->fetchrow_hashref ) {
            my $competitor = $results->{cname};
            my $url        = $results->{url};
            my $xpath      = $results->{xpath};
            my $region     = $results->{region};

            $work_q -> enqueue ( $url );
        }
    }
    $sth->finish;
    $dbh->disconnect;
}

for ( 1 .. $num_threads ) {
    threads->create( \&worker );
}

fetch_url_list();
$work_q->end;

foreach my $thr ( threads->list() ) {
    $thr->join();
}

这样-您的所有线程都没有在范围内的DB东西，而DB在范围内没有线程的东西。 这样可以减少造成您麻烦的“污染”几率。 特别是-线程在它们开始“复制”当前作用域中的所有内容时，当它们成为对象时，它们确实可以做一些更奇怪的事情。 （例如，数据库句柄）

如果失败，我将考虑采用“分叉”方法。 线程很擅长来回传递数据，但是当您不需要来回传递数据（并且您不需要运行测试并不需要进行传递）时，派生通常效率更高（在基于Unix的系统上肯定是这样）。打印结果）。