Perl:网站抓取时出现意外行为

前端之家收集整理的这篇文章主要介绍了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('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;
    }
}
}

解决方法

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

猜你在找的Perl相关文章