Perl: Неожиданное поведение при очистке веб-сайта

Я использую WWW::Mechanize и HTML::TokeParser для анализа веб-сайта на наличие обновлений. Я не могу дать никаких подробностей на веб-сайте, потому что он требует входа в систему. На веб-сайте по существу есть таблица данных. Я просто разбираю html, пока не доберусь до первой строки таблицы, проверяю, является ли это значением моей последней очистки, если нет, отправляю письмо. Это прекрасно работает, когда я проверяю существующие записи таблицы, за исключением того, что когда происходят фактические обновления, очистка не останавливается на моей последней очистке. Он продолжает отправлять письма до тех пор, пока таблица не будет исчерпана, и повторяет это бесконечно. Я не могу понять, что происходит. Я знаю, что мало кто может проверить без веб-сайта, но я все равно публикую свой код. Я был бы признателен за идеи о том, что может пойти не так.

код:

sub func{
    my ($comid, $mechlink) = @_;

    my $mechanize = WWW::Mechanize->new(
        noproxy  => 0,
        stack_depth => 5,
        autocheck => 1
    );

    $mechanize->proxy( https => undef );
    eval{
            my $me = $mechanize->get($mechlink);
            $me->is_success or die $me->status_line;
    };
    return $comid if ($@);  

    my $stream = HTML::TokeParser->new( \$mechanize->{content} ) or die $!;

    while ( $tag = $stream->get_tag('td') ) {
    if( $tag->[1]{class} eq 'dateStamp' ) {
        $dt = $stream->get_trimmed_text('/td');
        $tag = $stream->get_tag;
        $tag = $stream->get_tag;
        $name = $stream->get_trimmed_text('/td') if( $tag->[1]{class} eq 'Name' );
        return $comid unless( $tag->[1]{class} eq 'Name' );
        $tag = $stream->get_tag;
        $tag = $stream->get_tag;
        $tag = $stream->get_tag;
        $tag = $stream->get_tag;
        $info = $stream->get_trimmed_text('/td');
        print "$name?\n";
        return $retval if($info eq $comid);
        print "You've Got Mail! $info $comid\n";
        $tcount++;
        $retval = $info if($tcount == 1);
        $tag = $stream->get_tag;
        $tag = $stream->get_tag;
        $tag = $stream->get_tag;
        $link = "http://www.abc.com".$tag->[1]{href} if ($tag->[0] eq 'a' );
        my $outlook = new Mail::Outlook();
        my $message = $outlook->create();
        $message->To('[email protected]');
        $message->Cc('[email protected];[email protected]');
        my $hd = "$name - $info";  
        $message->Subject($hd);
        $message->Body(" ");
        $message->Attach($link);
        $message->send;
    }
}
}

perl www-mechanize
person Aks    schedule 20.06.2011    source источник
comment
Можете ли вы включить код для вашего цикла while - бит, где вы проверяете наличие обновлений. Скорее всего, здесь что-то пойдет не так.   -  person Mike    schedule 22.06.2011
comment
Я бы посоветовал вам добавить ведение журнала приложений, чтобы вы могли проверить больше из журналов. Кроме того, счетчик отправки почты и контролируемая остановка также хороши. Я несколько раз отправлял сотни писем из такой программы и знаю, как это может раздражать.   -  person weismat    schedule 22.06.2011
comment
Я добавил код в цикле. Проблема со счетчиком отправки почты заключается в том, что, во-первых, я понятия не имею, сколько обновлений можно ожидать от очистки к очистке. Во-вторых, даже если я устанавливаю ограничение, я запускаю один и тот же скрипт каждые 60 секунд, поэтому следующая итерация начинает отправлять письма снова и снова.   -  person Aks    schedule 22.06.2011

Ответы (5)


arrow_upward
6
arrow_downward

Для таких задач я предпочитаю использовать HTML::TableExtract . Его очень легко использовать:

use HTML::TableExtract;
$te = HTML::TableExtract->new( headers => [qw(header1 header2)]);
$te->parse($html);
foreach $ts ($te->tables) {
    foreach $row ($ts->rows) {
        my ($field1, $field2) = @$row;
        # Your code here
    }
}
person Francisco R    schedule 20.06.2011

arrow_upward
2
arrow_downward

Иногда на сайте бывают изменения. Я часто использую Web::Scraper. Можно написать, чтобы получить элемент с помощью XPath.

use Web::Scraper;
use URI;

my $uri = URI->new("http://....");
my $entries = scraper {
    process 'id("content")/div[@class="section"]', 'news[]' => scraper {
        process 'h2', title => 'TEXT';
        process 'p', body => 'TEXT';
    };
};

# if you have instance of WWW::Mechanize, set like following.
# $entries->user_agent($mech);

my $res = $entries->scrape( $uri );
for my $entry (@{$res->{news}}) {
    # use $entry->title or $entry->body
}
# language: lang-perl
person mattn    schedule 20.06.2011

arrow_upward
2
arrow_downward

Выйдите из цикла while, когда вы найдете то, что искали, иначе цикл будет продолжаться.

 while ( $tag = $stream->get_tag('td') ) {
    if( $tag->[1]{class} eq 'dateStamp' ) {
        $dt = $stream->get_trimmed_text('/td');
                    ...
                    ... 
        last;
    }
}
person manu_v    schedule 22.06.2011

arrow_upward
1
arrow_downward

Вы передаете $comid своей функции. В цикле while вы сначала устанавливаете $info, а затем сравниваете это с $comid. Если два значения совпадают, вы выходите из функции. Если они не совпадают, вы отправляете электронное письмо.

Как только электронное письмо отправлено, цикл продолжается и обрабатывается следующий тег. Когда вы в следующий раз сравните $info и $comid, я предполагаю, что они будут разными, так как вы перешли к следующему тегу. Поэтому будет отправлено другое электронное письмо.

Я не знаю, является ли это предполагаемым поведением - вы собираетесь отправлять одно электронное письмо для каждого обновления в таблице или только одно электронное письмо, если в таблице были какие-либо обновления? Если вам просто нужно отправить одно электронное письмо, независимо от того, сколько было обновлений, просто выйдите из цикла после отправки первого электронного письма — как предлагает manu_v.

Я бы также посмотрел на рефакторинг вашего кода, чтобы он был более надежным - все вызовы get_tag кажутся немного неубедительными. Ознакомьтесь с другими ответами, чтобы узнать, как это сделать.

person Mike    schedule 22.06.2011
comment
Если я правильно понимаю ваш код, вы сравниваете значение из таблицы ($info) со значением, переданным вашей функции ($comid). Если значение в таблице было обновлено, вам необходимо запомнить это новое значение, чтобы вы могли сравнить его при следующем сканировании. Если вы этого не сделаете, вы всегда будете сравнивать значение таблицы ($info) со старым значением ($comid) — оно всегда будет устаревшим, и поэтому будут отправляться электронные письма. Я не вижу, где и как вы сохраняете обновленное значение. Вы возвращаете только $comid, то есть значение, которое вы передали функции в первую очередь. - person Mike; 23.06.2011
comment
Также может помочь, если вы опубликуете HTML-код сканируемой таблицы. Вы можете заменить фактические значения фиктивными значениями, если данные являются конфиденциальными. - person Mike; 23.06.2011
comment
Хорошо. Я постараюсь опубликовать html. Я назначаю $retval самой верхней записи для этой конкретной очистки, а $retval возвращается, когда вы достигаете самой верхней очистки предыдущих итераций. $comid получает это как возвращаемое значение от функции и передается для следующей итерации - person Aks; 23.06.2011
comment
Я бы либо прошел через код с помощью отладчика, либо добавил бы обильное разбрызгивание операторов печати, чтобы гарантировать, что возвращается правильное значение и что вы сравниваете правильные значения. - person Mike; 23.06.2011
comment
Код отлично работает, когда я проверяю его на существующих записях. Но в тот момент, когда происходит обновление, происходит что-то странное. Я воспользуюсь некоторыми другими описанными способами и попробую. Спасибо за вашу помощь - person Aks; 23.06.2011

arrow_upward
1
arrow_downward

Мне кажется, что это больше проблема с завершением цикла, чем с TokeParser. Похоже, ваш цикл продолжает повторяться даже после того, как вы получите искомое значение.

Вы можете сделать что-то вроде:

While($x) {

  .
  .
  .
  last if ($foundWhatINeeded)
}
person Matt King    schedule 23.06.2011