Знакомьтесь, Active Perl.

Материал из 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