ICQ.com Search Parser

[Spyder]

В связи с неакутальностью гугла как поисковика для запросов типа inurl: - ограничение в 11 страниц и site: - ограничение примерно в 15 страниц, и соответсвенно разныз гугл граберов я написал нечто подобное, но работоющее с сервисом search.icq.com в которм как известно данных ограниченй нет (пока что нет =\)
Работает скрипт просто: Вы укзаываете ему запрос, путь к файлу для сохранения результата и при желании лимит на количество страниц. Страница каждый раз сохраняется в темп файл и уже оттуда идёт поиск по регулярному выражению. Естественно могут быть повторы ссылок, это особенность поисковика, особенно это станет заметно если вы не будете использовать лимит, тогда в конце файла будет много повторов.
Запросы для ICQ.com абсолютно такие же как и в гугле, т е можно использовать inurl, intext, intitle, site и тд

#!perl
use LWP;
if (@ARGV < 2) {
print "\n\n############################################## #####\n";
print "ICQ.com Search Parser by Spyder\n";
print "Usage: perl icq.pl \"<query>\" \<target> <page_limit>\n";
print "Like : perl icq.pl \"Antichat.ru\" C:/icq.txt 2\n";
print "If limit undefinide, search will be unlimited\n";
print "################################################## #\n\n\n";
exit;
}
if ($^O == "MSwin32") {
$tmp = "C:/icqtempfile.txt";
} else {
$tmp = "/tmp/icqtempfile.txt";
}
print "Start parsing for \"$ARGV[0]\"\n";
if ($ARGV[2]) {
$lim = $ARGV[2] * 10;
} else {
$lim = $pg+1;
}
&Parse;
sub Parse
{
for ($pg=0;;$pg=$pg+10) {
$q = $ARGV[0];
open (TRG,">>$ARGV[1]") or die "Can't save to $ARGV[1]:$!";
$url = "http://search.icq.com/search/results.php?q=$q&start=$pg";
$agent = LWP::UserAgent->new;
$req = HTTP::Request->new(GET => $url) or die "Can't connect to ICQ.com:$!";
$resp = $agent->request($req);
open (TMP, ">$tmp");
print TMP $resp->content;
close TMP;
open (TMP, "$tmp");
@mas = <TMP>;
if ($mas[136] =~ /<div class="nor1">/ or $pg == $lim) {
$all = $pg / 10;
print "Done! $all pages parsed\n";
print "Saved to $ARGV[1]\n";
return;
}
while (@mas) {
$str = shift @mas;
if ($str =~ m/\('http\S+'\)/) {
($q,$lnk,$q) = split /'/, $&;
print TRG "$lnk\n" if ($lnk ne $lnksf);
$lnksf = $lnk;
}
}
}
}

[Spyder]

Версия с гуи. К сожалению есть одна недоработка, после того как закончится парсинг вы не сможеет запустить его по новой: придётся запускать скрипт снова. В будущем постараюсь это исправить

#!perl
use LWP;
use Tk;
use Tk::DialogBox;
&Tk;
sub Tk
{
$main=MainWindow->new(-title => 'ICQ.com Search Parser by Spyder');
$main->geometry ('320x140');
$main->resizable (0,0);
$main->Label(-text => 'Enter query')->pack();
$quer=$main->Entry(-width => 50)->pack;
$main->Label(-text => 'Path to save result')->pack;
$trg=$main->Entry(-width => 50,
-textvariable => \$fs)->pack;
$main->Button(-text => 'Parsing',
-width=> '80',
-height=> '1',
-font => 'courier',
-command => \&Main)->pack(-side => 'bottom');
$main->Button(-text => 'Browse',
-command => \&filesave)->pack(-side => 'left');
$lim=$main->Entry(-width => 5)->pack(-side => 'right');
$main->Label(-text => 'Limit:')->pack(-side => 'right');
MainLoop;
}
sub filesave
{
$fs = $main->getSaveFile();
}
sub Main
{
$target = $trg->get;
$query = $quer->get;
$limit = int($lim->get);
if ($^O == "MSwin32") {
$tmp = "C:/icqtempfile.txt";
} else {
$tmp = "/tmp/icqtempfile.txt";
}
if ($limit) {
$lim = $limit * 10;
} else {
$lim = $pg+1;
}
&Parse;
}
sub Parse
{
for ($pg=0;;$pg=$pg+10) {
open (TRG,">>$target") or die "Can't save to $target:$!";
$url = "http://search.icq.com/search/results.php?q=$query&start=$pg";
$agent = LWP::UserAgent->new;
$req = HTTP::Request->new(GET => $url) or die "Can't connect to ICQ.com:$!";
$resp = $agent->request($req);
open (TMP, ">$tmp");
print TMP $resp->content;
close TMP;
open (TMP, "$tmp");
@mas = <TMP>;
if ($mas[136] =~ /<div class="nor1">/ or $pg == $lim) {
close TRG;
unlink $tmp;
$InfoWindow=$main->DialogBox(-title => 'Result', -buttons => ["OK"]);
$InfoWindow->add('Label', -text => "$limit Pages Parsed!", -font => '{Verdana} 8 bold',-foreground=>'red')->pack;
$InfoWindow->Show();
$InfoWindow->destroy;
return;
}
while (@mas) {
$str = shift @mas;
if ($str =~ m/\('http\S+'\)/) {
($q,$lnk,$q) = split /'/, $&;
print TRG "$lnk\n" if ($lnk ne $lnksf);
$lnksf = $lnk;
}
}
}
}