<code>#!/usr/bin/perl</code>
<code>use</code> <code>strict;</code>
<code>use</code> <code>warnings;</code>
<code>use</code> <code>threads;</code>
<code>use</code> <code>threads::shared;</code>
<code>use</code> <code>Thread::Queue;</code>
<code>use</code> <code>Thread::Semaphore;</code>
<code>use</code> <code>Bloom::Filter;</code>
<code>use</code> <code>URI;</code>
<code>use</code> <code>URI::URL;</code>
<code>use</code> <code>Web::Scraper;</code>
<code>use</code> <code>LWP::Simple;</code>
<code>use</code> <code>LWP::UserAgent;</code>
<code>use</code> <code>HTTP::Cookies;</code>
<code>#use HTTP::Cookies::Guess;</code>
<code>use</code> <code>String::Diff;</code>
<code>use</code> <code>String::Diff</code><code>qw(diff_fully diff diff_merge diff_regexp)</code><code>;</code>
<code>use</code> <code>URI::Split</code><code>qw(uri_split uri_join)</code><code>;</code>
<code>my</code> <code>$fid</code> <code>: shared;</code><code>#下載下傳的頁面以遞增的數字命名</code>
<code>share(</code><code>$fid</code><code>); </code><code>#多線程共享該變量</code>
<code>$fid</code><code>=0;</code>
<code>#crawling with signed cookie</code>
<code>my</code> <code>$cookie_jar</code> <code>=</code><code>'.mozilla/firefox/bg146ia6.default/cookies.sqlite'</code><code>;</code>
<code>my</code> <code>$tmp_ua</code> <code>= LWP::UserAgent->new; </code><code>#UserAgent用來發送網頁通路請求</code>
<code>$tmp_ua</code><code>->timeout(15); </code><code>##連接配接逾時時間設為15秒</code>
<code>$tmp_ua</code><code>->protocols_allowed( [</code><code>'http'</code><code>,</code><code>'https'</code> <code>] );</code><code>##隻允許http和https協定</code>
<code>$tmp_ua</code><code>->agent(</code>
<code>"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 2.0.50727;.NET CLR 3.0.04506.30; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)"</code>
<code> </code><code>)</code>
<code> </code><code>;</code><code>##用來在header中告訴伺服器你用的是什麼"浏覽器",設定檔案頭的User-Agent</code>
<code>$tmp_ua</code><code>->cookie_jar(HTTP::Cookies->new(</code><code>'file'</code><code>=></code><code>"$ENV{'HOME'}/$cookie_jar"</code><code>,</code><code>'autosave'</code><code>=>1));</code>
<code># 設定cookie,在運作過程中必須執行兩個方法,extract_cookies($request) 和 add_cookie_header($response)。在運作的過程中實際用到了HTTP::Cookies子產品。如:</code>
<code># $ua->cookie_jar({ file => "$ENV{HOME}/.cookies.txt" });</code>
<code># 等價于</code>
<code># require HTTP::Cookies;</code>
<code># $ua->cookie_jar(HTTP::Cookies->new(file => "$ENV{HOME}/.cookies.txt"));</code>
<code>push</code> <code>@{</code><code>$tmp_ua</code><code>->requests_redirectable},</code><code>'POST'</code><code>;</code><code>#告訴LWP在POST請求發送後如果發生重新定向就自動跟随</code>
<code>my</code> <code>$max_threads</code> <code>= 5;</code>
<code>my</code> <code>$base_url</code> <code>=</code><code>$ARGV</code><code>[0] ||</code><code>'http://www.cnblogs.com/zhangchaoyang/'</code><code>;</code>
<code>my</code> <code>$host</code> <code>= URI::URL->new(</code><code>$base_url</code><code>)->host;</code>
<code>print</code> <code>"Host Name: $host.\n"</code><code>;</code>
<code>my</code> <code>$queue</code> <code>= Thread::Queue->new( ); </code><code>#線程隊列,每個線程負責去處理一個url</code>
<code>my</code> <code>$semaphore</code> <code>= Thread::Semaphore->new(</code><code>$max_threads</code> <code>);</code>
<code>my</code> <code>$mutex</code> <code>= Thread::Semaphore->new( 1 );</code>
<code>#my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;</code>
<code>#my $logfile = "crawler".($year+1900).($mon+1).$mday.$hour.$min.$sec.".log";</code>
<code>#open(BANLOG,">>$logfile") or die("can't open logfile:$!\n");</code>
<code># Bloom::Filter使用更少的記憶體采用一種基于機率的算法來進行存在性測試。</code>
<code>my</code> <code>$filter</code> <code>= shared_clone( Bloom::Filter->new(</code><code>capacity</code> <code>=> 1000000,</code><code>error_rate</code> <code>=> 0.001) );</code>
<code>$queue</code><code>->enqueue(</code><code>$base_url</code> <code>); </code><code>#放入線程隊列的URL就要被線程所處理</code>
<code>$filter</code><code>->add(</code><code>$base_url</code> <code>); </code><code>#放入filter中好判斷該URL是否已經存在</code>
<code>my</code> <code>@tmp_url</code> <code>= (); </code><code>#@tmp_url存在處理過的url</code>
<code>push</code><code>(</code><code>@tmp_url</code><code>,</code><code>$base_url</code><code>);</code>
<code>while</code><code>( 1 )</code>
<code>{</code>
<code> </code><code># join所有可以被join的線程</code>
<code> </code><code>#my $joined = 0;</code>
<code> </code><code>foreach</code> <code>( threads->list(threads::joinable) )</code>
<code> </code><code>{</code>
<code> </code><code>#$joined ++;</code>
<code> </code><code>$_</code><code>-></code><code>join</code><code>( );</code>
<code> </code><code>}</code>
<code> </code><code>#print $joined, " joinedn";</code>
<code> </code><code># if there are no url need process.</code>
<code> </code><code>my</code> <code>$item</code> <code>=</code><code>$queue</code><code>->pending();</code><code>#傳回隊列中url的個數</code>
<code> </code><code># 線程隊列為空</code>
<code> </code><code>if</code><code>(</code><code>$item</code> <code>== 0 )</code>
<code> </code><code>my</code> <code>$active</code> <code>= threads->list(threads::running);</code>
<code> </code><code># 已經沒有active線程了,結束所有的工作</code>
<code> </code><code>if</code><code>(</code><code>$active</code> <code>== 0 )</code>
<code> </code><code>{</code>
<code> </code><code>print</code> <code>"All done!\n"</code><code>;</code>
<code> </code><code>last</code><code>;</code>
<code> </code><code>}</code>
<code> </code><code># 如果還有活動線程,那麼主線程sleep,等待處理URL的子線程結束</code>
<code> </code><code>else</code>
<code> </code><code>#print "[MAIN] 0 URL, but $active active threadn";</code>
<code> </code><code>sleep</code> <code>1;</code>
<code> </code><code>next</code><code>;</code>
<code> </code><code># 線程隊列不為空,信号量減1,占用一個線程來處理url</code>
<code> </code><code>#print "[MAIN] $item URLn";</code>
<code> </code><code>$semaphore</code><code>->down;</code>
<code> </code><code>#print "[MAIN]Create thread.n";</code>
<code> </code><code>threads->create( \</code><code>&ProcessUrl</code> <code>);</code>
<code>}</code>
<code># join all threads which can be joined</code>
<code>foreach</code> <code>( threads->list() )</code>
<code> </code><code>$_</code><code>-></code><code>join</code><code>( );</code>
<code>sub</code> <code>ProcessUrl</code>
<code> </code><code>my</code> <code>$scraper</code> <code>= scraper</code>
<code> </code><code>process</code><code>'//a'</code><code>,</code><code>'links[]'</code> <code>=></code><code>'@href'</code><code>;</code><code>#根據XPath表達式尋找所有的标簽a,把href屬性存到散列的value中</code>
<code> </code><code>};</code>
<code> </code><code>my</code> <code>$res</code><code>;</code>
<code> </code><code>my</code> <code>$link</code><code>;</code>
<code> </code><code>while</code><code>(</code><code>my</code> <code>$url</code> <code>=</code><code>$queue</code><code>->dequeue_nb() )</code>
<code> </code><code>eval</code><code>#eval BLOCK,BLOCK隻會被解析一次,并且在編譯時進行代碼文法檢查。</code>
<code> </code><code>{</code>
<code> </code><code>print</code> <code>"開始下載下傳"</code><code>,URI->new(</code><code>$url</code><code>)->as_string,</code><code>"\t\$fid=$fid\n"</code><code>;</code>
<code> </code><code>LWP::Simple::getstore(URI->new(</code><code>$url</code><code>)->as_string,</code><code>"$ENV{'HOME'}/master/cnblog/cn$fid"</code><code>) or</code><code>print</code> <code>"Can't download the web page."</code><code>;</code>
<code> </code><code>$fid</code><code>+=1;</code>
<code> </code><code>$scraper</code><code>->user_agent(</code><code>$tmp_ua</code><code>);</code><code>#設定$scraper的user_agent</code>
<code> </code><code>$res</code> <code>=</code><code>$scraper</code><code>->scrape( URI->new(</code><code>$url</code><code>) )->{</code><code>'links'</code><code>};</code><code>#把URI傳給scrape函數。scrape函數傳回一個數組引用,因為links是數組</code>
<code> </code><code>};</code>
<code> </code><code>if</code><code>( $@ )</code><code># 當BLOCK中有文法錯誤、運作時錯誤遇到 die 語句, eval 将傳回 undef 。錯誤碼被儲存在 $@ 中。</code>
<code> </code><code>warn</code> <code>"$@\n"</code><code>;</code>
<code> </code><code>next</code> <code>if</code> <code>(!</code><code>defined</code> <code>$res</code> <code>);</code><code>#如果HTML文檔中沒有發現a标簽</code>
<code> </code><code>#print "there are ".scalar(threads->list(threads::running))." threads, ", $queue->pending(), " urls need process.n";</code>
<code> </code><code>foreach</code><code>( @{</code><code>$res</code><code>} )</code>
<code> </code><code># $_ => URI->new("http://example.com/") 是以要調用sa_string來擷取"http://example.com/"</code>
<code> </code><code>$link</code> <code>=</code><code>$_</code><code>->as_string;</code>
<code> </code><code>$link</code> <code>= URI::URL->new(</code><code>$link</code><code>,</code><code>$url</code><code>);</code>
<code> </code><code>#$u1 = URI::URL->new($str, $base);</code>
<code> </code><code>#$u2 = $u1->abs;</code>
<code> </code><code># not http and not https?</code>
<code> </code><code>next</code> <code>if</code><code>(</code><code>$link</code><code>->scheme ne</code><code>'http'</code> <code>&&</code><code>$link</code><code>->scheme ne</code><code>'https'</code> <code>);</code>
<code> </code><code>#The three forms of URI reference syntax are summarized as follows:</code>
<code> </code><code>#<scheme>:<scheme-specific-part>#<fragment></code>
<code> </code><code>#<scheme>://<authority><path>?<query>#<fragment></code>
<code> </code><code>#<path>?<query>#<fragment></code>
<code> </code><code>#可以通過URL::Split把名個部分分離出來</code>
<code> </code><code># another domain?</code>
<code> </code><code># next if( $link->host ne $host );</code>
<code> </code><code>#search for the sub domain</code>
<code> </code><code>next</code> <code>if</code><code>(!(</code><code>$link</code><code>->host =~ /</code><code>$host</code><code>/));</code>
<code> </code><code>$link</code> <code>=</code><code>$link</code><code>-></code><code>abs</code><code>->as_string;</code><code>#獲得絕對路徑</code>
<code> </code><code>if</code><code>(</code><code>$link</code> <code>=~ /(.*?)</code><code>#(.*)/ )#去除書簽錨點,即#以後的内容</code>
<code> </code><code>{</code>
<code> </code><code>$link</code> <code>= $1;</code>
<code> </code><code>}</code>
<code> </code><code>next</code> <code>if</code><code>(</code><code>$link</code> <code>=~ /rss|.(jpg|png|bmp|mp3|wma|wmv|gz|zip|rar|iso|pdf)$/i );</code><code>#這些檔案格式我們不抓取</code>
<code> </code><code>#print "test:$link\n";</code>
<code> </code><code>#EscapeUrl,skip query form values</code>
<code> </code><code>my</code> <code>$tmp_link</code> <code>=</code><code>&EscapeUrl</code><code>(</code><code>$link</code><code>);</code><code>#$tmp_link中已經把查詢參數的值去掉了</code>
<code> </code><code>#print "Escape:".$tmp_link."\n";</code>
<code> </code><code>$mutex</code><code>->down();</code><code>#互質體減1,進入線程臨界資源區</code>
<code> </code><code>my</code> <code>$tmp_mark</code> <code>= 0;</code>
<code> </code><code>#print "test start:$link\n";</code>
<code> </code><code>if</code><code>( !</code><code>$filter</code><code>->check(</code><code>$tmp_link</code><code>) ) </code><code>#如果$tmp_link不在$filter中</code>
<code> </code><code>#print "Test filter ok:$tmp_link\n";</code>
<code> </code><code>#DiffUrl,diff $link from queue with number</code>
<code> </code><code>foreach</code><code>(</code><code>@tmp_url</code><code>)</code>
<code> </code><code>{</code>
<code> </code><code>#print "Test Queue:".$tmpurl."\n";</code>
<code> </code><code>#print "test-1:$_\ntest-2:$tmp_link\n";</code>
<code> </code><code>if</code><code>(</code><code>&DiffUrl</code><code>(</code><code>$_</code><code>,</code><code>$link</code><code>))</code><code>#如果發現@tmp_url中的url和目前頁面中的一個連結url僅是在某些數字上不同(很可能是查詢參數值不同),則跳過該連結,即跳到else裡面去。</code>
<code> </code><code>{</code>
<code> </code><code>$tmp_mark</code> <code>= 2;</code>
<code> </code><code>last</code><code>;</code>
<code> </code><code>}</code>
<code> </code><code>}</code>
<code> </code><code>if</code><code>(</code><code>$tmp_mark</code> <code>!= 2 )</code>
<code> </code><code>$queue</code><code>->enqueue(</code><code>$link</code><code>); </code><code>#把頁面上的連結$link交給線程進行處理</code>
<code> </code><code>#print "add queue:$link\n";</code>
<code> </code><code>$filter</code><code>->add(</code><code>$tmp_link</code><code>);</code><code>#$tmp_link放入$filter</code>
<code> </code><code>#print "add filter:$tmp_link\n";</code>
<code> </code><code>#print BANLOG $filter->key_count(), " ", $link, "\n";</code>
<code> </code><code>#print $filter->key_count(), " ", $link, "\n";</code>
<code> </code><code>push</code><code>(</code><code>@tmp_url</code><code>,</code><code>$link</code><code>);</code><code>#把$link放入已處理的url數組@tmp_url</code>
<code> </code><code>else</code>
<code> </code><code>#print "pass:$link\n";#$link被忽略</code>
<code> </code><code>#print "pass:$link\n";</code>
<code> </code><code>$mutex</code><code>->up();</code><code>#互斥信号量加1</code>
<code> </code><code>undef</code> <code>$link</code><code>;</code>
<code> </code><code>undef</code> <code>$res</code><code>;</code><code>#清除建立的一些object,否則在while循環中這些object越積越多</code>
<code> </code><code>undef</code> <code>$scraper</code><code>;</code>
<code> </code><code>$semaphore</code><code>->up( );</code><code>##普通信号量加1</code>
<code>#close(BANLOG);</code>
<code>print</code> <code>"ALL DONE.\n"</code><code>;</code>
<code>#把URL尾部的request參數置為空</code>
<code>#比如http://category.dangdang.com/?ref=www-0-C&name=orisun-zhang#ref=www-0-C被處理為http://category.dangdang.com/?ref=&name=</code>
<code>sub</code> <code>EscapeUrl</code>
<code> </code><code>my</code> <code>$urlold</code> <code>=</code><code>shift</code><code>;</code>
<code> </code><code>my</code> <code>(</code><code>$scheme</code><code>,</code><code>$auth</code><code>,</code><code>$path</code><code>,</code><code>$query</code><code>,</code><code>$frag</code><code>) = uri_split(</code><code>$urlold</code><code>);</code><code>#把一個url的各部分分離出來</code>
<code> </code><code>my</code> <code>$urlnew</code> <code>= uri_join(</code><code>$scheme</code><code>,</code><code>$auth</code><code>,</code><code>$path</code><code>);</code>
<code> </code><code>my</code> <code>$u</code> <code>= URI->new(</code><code>$urlold</code><code>);</code>
<code> </code><code>my</code> <code>@tmp_array</code> <code>=</code><code>$u</code><code>->query_form();</code>
<code> </code><code>my</code> <code>$tmp</code> <code>=</code><code>''</code><code>;</code>
<code> </code><code>my</code> <code>$i</code> <code>= 0;</code>
<code> </code><code>for</code><code>(</code><code>$i</code><code>=0;</code><code>$i</code><code><</code><code>@tmp_array</code><code>;</code><code>$i</code><code>+=2)</code><code>#把request參數的值去掉</code>
<code> </code><code>$tmp</code> <code>.=</code><code>$tmp_array</code><code>[</code><code>$i</code><code>].</code><code>"=&"</code><code>;</code>
<code> </code><code>if</code><code>(</code><code>@tmp_array</code> <code>!= 0)</code>
<code> </code><code>$tmp</code> <code>=~ s/&$//;</code>
<code> </code><code>$urlnew</code> <code>.=</code><code>"?"</code><code>.</code><code>$tmp</code><code>;</code>
<code> </code><code>undef</code> <code>$u</code><code>;</code><code>#清除子例程中建立的object</code>
<code> </code><code>#print $urlnew."\n";</code>
<code> </code><code>return</code> <code>$urlnew</code><code>;</code>
<code>sub</code> <code>DiffUrl</code>
<code> </code><code>my</code> <code>$urlnew</code> <code>=</code><code>shift</code><code>;</code>
<code> </code><code>my</code> <code>$urloldx</code> <code>=</code><code>&EscapeUrl</code><code>(</code><code>$urlold</code><code>);</code>
<code> </code><code>my</code> <code>$urlnewx</code> <code>=</code><code>&EscapeUrl</code><code>(</code><code>$urlnew</code><code>);</code>
<code> </code><code>my</code><code>(</code><code>$old</code><code>,</code><code>$new</code><code>) = String::Diff::diff(</code><code>$urloldx</code><code>,</code><code>$urlnewx</code><code>);</code>
<code> </code><code>#my($old,$new) = String::Diff::diff($urlold,$urlnew);</code>
<code> </code><code>if</code> <code>((</code><code>$old</code> <code>=~ m/(\[\d+\])/i) && (</code><code>$new</code> <code>=~ m/{\d+}/i)) </code><code>#如果兩個url僅是在某些數字上不同</code>
<code> </code><code>#if ($new =~ m/{\d+}/i)</code>
<code> </code><code>#print "test num success.\n";</code>
<code> </code><code>return</code> <code>1;</code>
<code> </code><code>else</code>
<code> </code><code>#print "test num failed.\n";</code>
<code> </code><code>return</code> <code>0;</code>