为什么我的脚本没有处理数组中的所有元素？

Question

以下代码是一个测试，用于测试我已经使用新发现的线程知识完成的操作。

#!/usr/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;
use URI;
use URI::http;
use File::Basename;
use DBI;
use HTML::Parser;
use LWP::Simple;
require LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
$ua->max_redirect(0);

print "Starting main program\n";

my @urls = ('http://www.actwebdesigns.co.uk', 'http://www.1st4pets.com', 'http://www.special4you.com');
my @threads;
while ( @urls ) {
        my $url = shift ( @urls );
        my $t = threads->new(\&scan, $url);
        push(@threads,$t);
}
while (@threads) {
        my $url_thread = shift(@threads)->join;
}
sub resolve_href {
    my ($base, $href) = @_;
    my $u = URI->new_abs($href, $base);
    return $u->canonical;   
}
sub redirect_test {
    my $url = shift;
    my $redirect_limit = 10;
    my $y = 0;
    my( $response, $responseCode );
    while( 1 && $y le $redirect_limit ) {
        $response = $ua->get($url);
        $responseCode = $response->code;
        if( $responseCode == 200 || $responseCode == 301 || $responseCode == 302 ) {
            if( $responseCode == 301 || $responseCode == 302 ) {
                $url = resolve_href( $url, $response->header('Location') );
            }else{
                last;
            }
        }else{
            last;
        }
        $y++;
    }
    return ($url, $response, $responseCode, $redirect_limit, $y );
}
sub scan {
        my $url = shift;
        my @hrefs_found;
        print "started scanning: $url\n";
        my $info = URI::http->new($url);
        # if url is not an absolute url
        if( ! defined( $info->host ) ) {
            print "Invalid URL: $url \n";    
        }else{
             my $host = $info->host;
            $host =~ s/^www\.//;
            # check to see if url is valid, checks for redirects (max of 10)
            my @urlI = redirect_test( $url );
            my $content = '';
            # checks to see if url did not redirect more than 10 times and that response returned was 200
            if( $urlI[4] != $urlI[3] && $urlI[2] == 200 ) { 
                $content = $urlI[1]->content;
                die "get failed: " . $urlI[0] if ( ! defined $content );
            }
            # sticks all hrefs on a page in an array
            my @pageLinksArray = ( $content =~ m/href=["']([^"']*)["']/g );
            # foreach links found
            foreach( @pageLinksArray ) {
                # make href an absolute url
                my $url_found = resolve_href( $urlI[0], $_ );
                # check if url looks like a valid url
                if( $url_found =~ m/^http:\/\// ) {
                    my $info = URI::http->new($url_found);
                    # check to see if url is a valid url
                    if( ! defined( $info->host ) ) {
                        print "Invalid URL: $url_found \n";    
                    }else{
                        my %values_index;
                        @values_index{@hrefs_found} = ();
                        my %values_index2;
                        @values_index2{@urls} = ();
                        # if url is not already been found
                        if( ! exists $values_index{$url_found} && ! exists $values_index2{$url_found} ) {
                            # add to arrays
                            push( @hrefs_found, $url_found );
                            push( @urls, $url_found );
                        }
                    }
                }
            }
            print "$url found " . scalar @hrefs_found . "\n";

        }
        return $url;
}

问题是，在脚本末尾附近，新找到的 url 被添加到数组中，但脚本顶部的代码没有处理它们，即它只遍历第一个测试 url。

谁能明白为什么会发生这种情况？

问候，

菲尔

编辑 **

我尝试通过执行以下操作来暂停它：

while ( @urls ) {
my $url = shift ( @urls );
my $t = threads->new(\&scan, $url);
push(@threads,$t);
my $n = 0;
while( 1 ) {
    if( scalar @urls == 1 ) {
        sleep 10;
    }else{
        last;
    }
    if( $n >= 1 ) {
        print "IN ARRAY URLS:\n\n";
        print @urls;
        print "\n\n";
        die "Process taking too long.";
        last;
    }
    $n++;
}

}

但它没有似乎什么也没做。

结果是：

Starting main program
started scanning: http://www.actwebdesigns.co.uk
started scanning: http://www.1st4pets.com
http://www.actwebdesigns.co.uk found 24
http://www.1st4pets.com found 17
IN ARRAY URLS:

http://www.stackoverflow.com

Process taking too long. at C:\perlscripts\thread.pl line 38.
Perl exited with active threads:
        0 running and unjoined
        2 finished and unjoined
        0 running and detached

Answer 1

据我所知，您正在启动一个线程来获取原始列表中的每个 URL，浏览它，并将找到的 URL 添加到原始列表中。

问题是，所有获取和匹配都需要一段时间，并且启动线程的循环可能会在添加第一个新 URL 之前完成。此后它不会再次查看列表，因此不会处理新的 URL。

作为参考，您确实应该进行某种同步和信号发送。大多数语言使用互斥体、“条件”或信号量来做到这一点。除非您执行类似的操作，否则您基本上必须在加入前一个 while 循环中的每批线程之后一遍又一遍地运行 while 循环。

实际上......

查看文档，我发现这个：

自 5.6.0 起，Perl 支持一种称为解释器线程 (ithreads) 的新型线程。这些线程可以显式和隐式使用。

Ithreads 通过克隆数据树来工作，这样不同线程之间就不会共享数据。

好消息/坏消息时间。好消息是，您不必担心 @urls 首次出现时的线程安全访问。坏消息是这样做的原因：每个线程都有不同的 @urls，因此如果没有额外的帮助，您无法在它们之间共享数据。

您可能想要做的是在列表上下文中创建线程，并让它返回找到的 URL 列表，然后您可以在加入线程时将其附加到 @urls。如果您不知道线程安全问题，替代方案（在线程之间共享@urls）可能会很快变得丑陋。

不管你怎么做，都会导致脚本消耗大量资源——仅仅三个测试 URL 就包含了 42 个其他 URL，而且其中很多可能都有自己的 URL。因此，如果您要为每个请求启动一个线程，那么您很快就会创建比任何机器能够处理的线程还要多的线程。

Answer 2

默认情况下，每个线程都有自己的私有数据副本。也就是说，当您在一个线程中向 @urls 添加新元素时，所有其他线程中的 @urls 副本不会更新，包括 "父”线程/进程。

当您准备好打开另一罐蠕虫时，请查看 threads:: Shared 模块，它提供了一种笨重但可用的方法来在线程之间共享数据。