Материал из Wiki.
[править] PR чекер на перле за 10 минут.
Эта статья - быстрый старт для тех, кто хочет научиться программировать на perl-е и для тех, кому просто любопытно узнать, что он умеет.
Я напишу последовательность шагов, начиная с инсталляции перла под Windows и заканчивая работающим скриптом. Здесь не будет подробного описания синтаксиса языка. Эту информацию можно легко найти в книгах, в интернете или изучать постепенно при написании более сложных скриптов.
С самого начала обращайте внимание на правильное использование готовых библиотек и документации - это пригодится при написании программ на любом языке.
1) скачиваем инсталляцию Active perl-a для windows и устанавливаем его.
Заполняйте небольшую форму и скачивайте msi файл, 12 метров
2) изначально работа идет с командной строки. так что запускаем cmd.exe или far, кому что больше нравится, и запускаем ppm.exe - "Perl Package Manager"
То же самое можно сделать из меню Пуск -> ActivePerl 5.8.8 Build 817 -> Perl Package Manager
Список основных команд выводит 'help'. Наберите 'search google', должен получиться такой результат:
Code:
ppm> search google
Using cached search result set 1.
1. Games-GoogleWhack [1.4] Games-GoogleWhack
2. Geo-Coder-Google [0.1] Geo-Coder-Google
3. Geo-Google [0.01] Geo-Google
4. HTML-GoogleMaps [4] HTML-GoogleMaps
5. Text-Emoticon-GoogleTalk [0.01] Text-Emoticon-GoogleTalk
6. WebService-Google-Sets [0.01] WebService-Google-Sets
7. WebService-Google-Suggest [0.01] WebService-Google-Suggest
8. WWW-Cache-Google [0.04] WWW-Cache-Google
9. WWW-Google-News [0.11] WWW-Google-News
10. WWW-Google-News-TW [0.11] WWW-Google-News-TW
11. WWW-Google-PageRank [0.11] WWW-Google-PageRank
12. WWW-Google-SiteMap [0.03] WWW-Google-SiteMap
13. WWW-Google-Video [0.2] WWW-Google-Video
сегодня нас интересует WWW-Google-PageRank. Устанавливаем его командой 'install WWW-Google-PageRank':
Code:
ppm> install WWW-Google-PageRank
====================
Install 'WWW-Google-PageRank' version 0.11 in ActivePerl 5.8.8.817.
====================
Downloaded 3339 bytes.
Extracting 5/5: blib/arch/auto/WWW/Google/PageRank/.exists
Installing C:\Progs\Perl\html\site\lib\WWW\Google\PageRank.html
Installing C:\Progs\Perl\site\lib\WWW\Google\PageRank.pm
Successfully installed WWW-Google-PageRank version 0.11 in ActivePerl 5.8.8.817.
3) Из меню Пуск -> ActivePerl 5.8.8 Build 817 -> Documentation запускаем документацию по перлу.
В левой колонке находим WWW -> Google -> PageRank, и копируем строки из хелпа в текстовый файл скрипта test-pr.pl:
Code:
use WWW::Google::PageRank;
my $pr = WWW::Google::PageRank->new;
print scalar($pr->get('http://www.yahoo.com/')), "\n";
запускаем скрипт 'perl.exe test-pr.pl' и получаем на экране цифру 9. Это PR сайта http://www.yahoo.com
4) Доработаем скрипт, чтобы он брал url-ы для проверки из текстового файла 'urls.txt', а результат помещал в текстовый файл 'urls-pr.txt'
Файл check-pr.pl:
Code:
use WWW::Google::PageRank;
#считываем строки файла urls.txt в массив
$fin='urls.txt';
open(FILER, $fin) || die "Файл $fin не найден!";
@arurls=<FILER>;
close(FILER);
#создаем файл для вывода результатов скрипта в формате csv
$fout='>urls-pr.txt';
open(FOUT, $fout) || die "Файл не найден!";
$pr = WWW::Google::PageRank->new;
#обработка каждой строки массива
foreach $surl (@arurls)
{
chomp $surl; #удалить 'enter' в конце строки
$spr=scalar($pr->get($surl));
print FOUT "$spr;$surl\n"; #вывод в файл
print "$spr;$surl\n"; #вывод на экран
}
close(FOUT);
В итоге получился компактный и несложный скрипт, выполняющий полезную функцию
[править] Локальный бид чекер на перле.
Сегодня будем разбирать полезный скрипт, который выполняет проверку бидов через фид.
В скрипте используются модуль HTTP::Request для работы с web и удобный модуль для работы с XML XML::Simple.
Обратимся снова к документации. Запускаем ActivePerl User Guide и слева в содержании находим LWP -> UserAgent. За основу берем пример из help-a:
Code:
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
my $response = $ua->get('http://search.cpan.org/');
if ($response->is_success) {
print $response->content; # or whatever
}
else {
die $response->status_line;
}
Для удобства http запрос на получение html (xml) страницы вынесем в отдельную процедуру. Так ее можно будет использовать в других скриптах.
Я добавил повторные запросы к серверу при таймауте или другой ошибке - переменная $ntries и запись в файл, указанный в переменной $ftmp, чтобы можно было проанализировать ответ от сервера.
Code:
sub GetURL {
my ($URL, $fileout) = @_;
$ntries=3;
my $ua = LWP::UserAgent->new;
$ua->timeout(20);
#следующая строка позволяет работать через прокси
#$ua->proxy('http', "http://192.168.0.1:3128");
TRY1:
my $response = $ua->get($URL);
if (!($response->is_success)) {
print $response->status_line, "\n";
$ntries--;
if ($ntries>0) {
goto TRY1;
}
else {
return "error";
}
}
$result = $response->content; # or whatever
#запись в файл
open(FOUTX, $fileout) || die "File not found!";
print FOUTX "$URL\n\n";
print FOUTX $result;
close(FOUTX);
return $result;
}
Фид использует следующий url для получения дополнительной информации с кликвипа:
http://xml.klikvip.com/xml.php?aff=00000&saff=0&ip=62.26.118.190&q=xenical&ref=&st=link&n=5
aff=00000 - впишите свой aff на кликвипе. пожалуйста, проявите уважение к себе и другим и не используйте для проверки чужой фид.
ip=62.26.118.190 - это американский ip, если поменять, то можно узнать биды по другим странам.
q=xenical - собственно кейворд
n=5 - количество результатов
В результате запроса к серверу получим xml, из которого узнаем максимальный бид для кейворда:
Code:
my $xdata = XMLin($res);
$bid = $xdata->{record}[0]->{bid};
Осталось написать цикл для каждого кейворда, в котором будет формирование урла, вызов GetURL и получение бида из XML. Кейворды скрипт берет из файла bids2check.txt, результат записывает в файл bids-out.txt и выводит на экран. Получится такой скрипт:
Code:
#!/usr/bin/perl -w
use LWP::UserAgent;
use HTTP::Request::Common qw(GET);
use XML::Simple;
#файл, в котором можно посмотреть ответ от сервера
$ftmp=">bid.tmp";
#файл с кейвордами для проверки
$fin = 'bids2check.txt';
open(FILER, $fin) || die "Файл не найден!";
@ar=<FILER>;
close(FILER);
#файл в формате бид - кейворд
$fout=">bids-out.txt";
open(FOUT, $fout) || die "Файл не найден!";
#http://xml.klikvip.com/xml.php?aff=00000&saff=0&ip=62.26.118.190&q=xenical&ref=&st=link&n=5
$xurl1='http://xml.klikvip.com/xml.php?aff=00000&saff=0&ip=62.26.118.190&q=';
$xurl2='&ref=&st=link&n=5';
foreach $i (@ar)
{
chomp $i;
$i=~s/\s/\+/g;
$xurl="$xurl1$i$xurl2";
$res=GetURL($xurl,$ftmp);
next if ($res=~/error/);
#---XML-------------------------
my $xdata = XMLin($res);
$bid = $xdata->{record}[0]->{bid};
print "$bid\t$i\n";
print FOUT "$bid\t$i\n";
}
close(FOUT);
#-----------------------------------------------------------------------------------
sub GetURL {
my ($URL, $fileout) = @_;
$ntries=3;
my $ua = LWP::UserAgent->new;
$ua->timeout(20);
#следующая строка позволяет работать через прокси
#$ua->proxy('http', "http://192.168.0.1:3128");
TRY1:
my $response = $ua->get($URL);
if (!($response->is_success)) {
print $response->status_line, "\n";
$ntries--;
if ($ntries>0) {
goto TRY1;
}
else {
return "error";
}
}
$result = $response->content; # or whatever
#запись в файл
open(FOUTX, $fileout) || die "File not found!";
print FOUTX "$URL\n\n";
print FOUTX $result;
close(FOUTX);
return $result;
}
Несложно получить нескольких бидов для одного кейворда или вычислить средний.
Пусть это будет задание для самостоятельной работы.
© Elmaros
Источник | 08 сентября 2006