#!/usr/bin/perl $|=1; use LWP; use LWP::UserAgent; my $sc_agent='Строка юзер-агента'; my $dbf='Файл, куда линки сохраним'; my $fts='pl|html|htm|php|phtml|shtml|asp|php3|php4|php5'; #типы файлов, которые остаются, после очистки мусора(картинок и т.д.) my $temp; my @url; my $base_url='http://forum.ru-board.com'; #Откуда начнем "бегать" unless ($base_url=~m/[\\\/][^\\\/\.]+$/) {$base_url=~s/[\\\/]$//g;} $url[0]=$base_url; my $i=0; my $linkpos; print "Crawler started[$base_url], working...\n"; my $j=0; while ($i<5) { #$i<количество опрошенных страниц $linkpos=$url[$i]; unless ($url[$i] eq '') { print $url[$i],"\n"; $data=grabpage($url[$i], $sc_agent); $data=~s/[\r\n]+//g; while ($data=~m/(<a [^>]+>)/is) { $temp=$1; $data=~s/<a [^>]+>//is; $temp=~m/<a [^>]*href=['"]?([^<>'"]*)['"]?[^>]*>/is; $temp=$1; $temp=~s/[^a-z0-9^\.\\\/\?_\-:\+=&\%\$]+//ig; unless ($temp=~m/^[a-z]+:/i || $temp eq '') { $temp=make_full($linkpos,$temp); #Fixing / || \ pairs if ($temp=~m/^https?:\/{2}/i) { $temp=~s/([^:])[\\\/]{2,}/$1\//g; } else { $temp=~s/[\\\/]{2,}/\//g; } $url[$j]=$temp; #print " - $temp\n"; Разблокировать для отладки $j++; } } @url=clear_links(@url); @url=clean_pairs(@url); select(undef,undef,undef,0.01); #Ожидание между запросами страниц, дабы не перегружать машину и канал, можно убрать } $i++; } |