@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
Запускает цикл, пока существуют домены в массиве и постоянно добавляет и запускает новые потоки. Функция обработки потоков удаляет один домен из общего массива и выполняет действия с ним. Соответственно основной цикл закончится когда закончатся все домены.
  • Вопрос задан
  • 831 просмотр
Пригласить эксперта
Ответы на вопрос 1
@Rozello
Судя по задаче, могу сказать что наверное вам имеет смысл посмотреть в сторону модуля Coro, иначе ваши потоки будут жрать ресурсы как ненормальные.
Ответ написан
Комментировать
Ваш ответ на вопрос

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

Похожие вопросы