@jslby

Как реализовать потоки в Perl?

Хочу разобраться с мультипоточностью на более простом скрпте:

use strict;
use warnings;
use Getopt::Std;
use HTTP::Cookies;
use threads;
use threads::shared;
use LWP;
use HTTP::Request::Common qw(POST);
use HTTP::Request::Common qw(GET);
use Data::Dumper qw(Dumper);

my $cookie_jar = HTTP::Cookies->new(
    file => 'wpcheck.dat',
    autosave => 1,
);

getopt('d:t:');

our($opt_d, $opt_t, $dfh);

my @threads;
my @domains;
my @running;

open($dfh, '<:encoding(UTF-8)', $opt_d) or die "Could not open '$opt_d' $!";
while(my $thisDomain = <$dfh>){
    chomp $thisDomain;
    push @domains, $thisDomain;
}

while(@domains){
    @running = threads->list(threads::running);
    if(scalar @running < $opt_t){
        push @threads, threads->new(\&check);
        # Вот тут скрипт выходит и всё.
    }
   
    foreach (@threads){
        if($_->is_joinable()){
            $_->join();
        }
    }
}

sub check{
    my $el = pop(@domains);
    my $ua = LWP::UserAgent->new;

    $ua->cookie_jar($cookie_jar);

    my $resp = $ua->get("http://$el/wp-login.php");

    if($resp->code() == 200){
        print "$el\n";
    }
}


Отписал комментарием в коде где происходит остановка скрипта. Никаких ошибок и предупреждений. Не могу только это понять. Суть скрипта:

Скрипт запускается и получает очередь доменов из файла.
Создает очередь потоков равным входящему параметру -t
Запускает цикл, пока существуют домены в массиве и постоянно добавляет и запускает новые потоки. Функция обработки потоков удаляет один домен из общего массива и выполняет действия с ним. Соответственно основной цикл закончится когда закончатся все домены.
  • Вопрос задан
  • 821 просмотр
Пригласить эксперта
Ответы на вопрос 2
kloppspb
@kloppspb
Для начала, надо бы объявить массив @domains как shared. Потом, мне, если честно, не хочется ломать мозг в раздумьях почему вы сделали именно так, а не иначе, и что имелось в виду в какой строчке цикла while(@domains){. Поэтому набросаю на коленке:

my @domains :shared;

# ...

while( @domains )
{
    my $threads = threads->list(threads::running);
    if( $threads < $opt_t )
    {
      my $th = threads->create(\&check);
      $th->join();
    }
}

И всё, нечего тут огород городить. Остальное - уже доводка (например, почему бы просто не создать $opt_t потоков и разбирать очередь заданий в них, а не создавать на каждый домен новый поток, и т.д.)
Ответ написан
@Rozello
Судя по задаче, могу сказать что наверное вам имеет смысл посмотреть в сторону модуля Coro, иначе ваши потоки будут жрать ресурсы как ненормальные.
Ответ написан
Комментировать
Ваш ответ на вопрос

Войдите, чтобы написать ответ

Войти через центр авторизации
Похожие вопросы