2010-09-24 93 views
-1

下面的代碼是一個測試,以測試我已經用我新發現的線程知識所做的事情。爲什麼我的腳本沒有處理數組中的所有元素?

#!/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; 
} 

的問題是,靠近該腳本的新發現的網址被添加到陣列中,但在腳本的頂部代碼的端部不處理它們,即它僅通過第一測試網址去。

任何人都可以看到爲什麼會發生這種情況嗎?

問候,

菲爾

編輯* *

我試圖做這樣的事情暫停:

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 
+0

凹凸,任何人? – 2010-09-24 11:34:54

+1

如果您將問題簡化爲能夠演示問題的最小腳本,則幫助您更容易。大多數人不會想要通過你的漫長而複雜的腳本去處理各種各樣的事情。如果你提出更好的問題,更多的人會對幫助你感興趣。 – 2010-09-24 15:45:23

回答

3

從我所看到的,你開始一個線程來獲得在原始列表中的每個URL,通過它看,發現添加到原來的列表中的網址。

問題是,所有得到和匹配都需要一段時間,並且啓動線程的循環可能會在第一個新URL被添加之前完成。在那之後它不再查看列表,所以新的URL將不會被處理。

作爲參考,你真的應該有某種同步和信號繼續。大多數語言都使用互斥鎖,「條件」或信號量來做到這一點。直到你做了這樣的事情之後,基本上必須在你加入前一個while循環的每批線程後反覆運行你的while循環。

其實...

回顧過去的文檔,我發現this

5.6.0以來,Perl已經有一種新型線程調用解釋線程(在ithread)的支持。這些線程可以明確地和隱含地使用。

Ithread通過克隆數據樹工作,以便不同線程之間不共享數據。

好消息/壞消息時間。好消息是,您不必擔心在第一次出現時線程安全地訪問@urls。壞消息是這樣的原因:每個線程有不同的@urls,所以你不能在沒有額外幫助的情況下在它們之間共享數據。

您可能想要做的事情是在列表上下文中創建線程,並讓它返回找到的URL的列表,然後當線程返回時,您可以將其追加到@urls。如果您不知道線程安全問題,則可以使用另一種方法(在線程之間共享@urls)變得非常快速。

但是你這樣做會導致腳本佔用大量資源 - 只有三個測試URL包含42個其他URL,並且其中一些URL可能包含自己的URL。所以如果你要爲每個請求啓動一個線程,你很快就會創建更多的線程,而不是任何機器可以處理的線程。

+0

有無論如何我可以暫停第一個循環,如果只有1條留下來? – 2010-09-24 07:37:16

+0

它似乎不是推動網址 – 2010-09-24 08:48:25

+0

就是這樣,以及線程之間不共享數據的事實。 – mob 2010-09-24 15:30:15

1

默認情況下,每個線程都有自己的私人數據副本。也就是說,當您在一個線程中向@urls添加新元素時,所有其他線程中的@urls副本不會更新,包括「父」線程/進程中的副本。

當您準備打開另一罐蠕蟲時,請查看threads::shared模塊,該模塊提供了一種笨拙但可用的方式在線程之間共享數據。

相關問題