Perl：网站抓取的意外行为

Question

我正在使用 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('abc@def.com');
        $message->Cc('abc@def.com;abc@def.com');
        my $hd = "$name - $info";  
        $message->Subject($hd);
        $message->Body(" ");
        $message->Attach($link);
        $message->send;
    }
}
}    

Answer 1

在我看来，这更多是循环终止的问题，而不是 TokeParser 的问题。听起来您的循环即使在您获得所需的值之后仍在继续迭代。

您可能想要执行以下操作：

While($x) {

  .
  .
  .
  last if ($foundWhatINeeded)
}

Answer 2

您将$comid 传递给您的函数。在您的 while 循环中，您首先设置 $info，然后将其与 $comid 进行比较。如果两个值匹配，则退出该函数。如果它们不匹配，则发送电子邮件。

电子邮件发送后，循环继续，并处理下一个标签。当您下次比较 $info 和 $comid 时，我猜它们会有所不同，因为您已转到下一个标签。因此将发送另一封电子邮件。

我不知道这是否是预期的行为 - 您打算为表格中的每个更新发送一封电子邮件，还是如果表格有任何更新则只发送一封电子邮件？如果您只需要发送一封电子邮件，无论有多少更新，那么只需在发送第一封电子邮件后退出循环 - 正如 manu_v 所建议的那样。

我还会考虑重构您的代码，使其更加健壮 - 所有get_tag 调用似乎都有些脆弱。查看其他答案以获取有关如何执行此操作的建议。

Answer 3

当你匹配到你要找的东西时退出while循环，否则它会继续循环。

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

Answer 4

有时，网站会发生变化。我经常使用 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

Answer 5

对于这类任务，我更喜欢使用 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
    }
}