[Perl]Mojo::UserAgent 抓取某诗词网站页面

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
523066680
Administrator
Administrator
帖子: 440
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 42 times
Been thanked: 70 times
联系:

[Perl]Mojo::UserAgent 抓取某诗词网站页面

帖子 #1 523066680 » 2018年12月07日 15:13

该网站的文章页面有手机版的,体积比PC端页面小一半以上,可以减少数据处理量。

代码: 全选

=info
    523066680
/vicyang
    2018
-12
=cut

use Encode
;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use File::Path qw/mkpath/;
use Try::Tiny;
STDOUT->autoflush(1);

our $ua = Mojo::UserAgent->new();
our $main = "http://www.52shici.com";
our $wdir = "D:/temp/52shici_mobile";
mkpath $wdir unless -e $wdir;

#获取主类
my $max;
my $route;
my $item;
my $res = $ua->get( $main )->result;
for my $e ($res->dom->find(".works-type-list a")->each )
{
    $route = $e->attr("href");
    $item = encode('gbk', $e->text);
    printf "%s %s\n", $route, $item; 
    $max 
= get_max_pgcode( "${main}/${route}" );
    get_article( "${main}/${route}", $max, $item );
}

sub get_article
{
    our ($main, $wdir);
    my ( $link, $max, $item ) = @_;
    my $res;
    my $detail;
    my $path = "${wdir}/${item}";
    my $file;
    my $target;

    mkpath $path unless -e $path;
    chdir $path;

    # 遍历所有页码
    for my $code ( 1 .. $max )
    {
        printf "%s, Page code: %d/%d\n", $item, $code, $max;
        $res = try_to_get( "${link}&page=${code}" );

        my $count = 1;
        # 每一篇文章
        for my $e ( $res->dom->find(".l a")->each )
        {
            # URL中的请求部分
            $e->attr('href') =~/\?(.*)&/;
            $file = $.".html";
            $target = $main ."/". $e->attr('href');
            $target =~s/&.*$//;
            $target =~s/www\./m\./;

            next if -e $file;
            $detail = try_to_get( $target );
            write_file( $file , $detail->body );
        }
    }
}

sub get_max_pgcode
{
    my ( $link ) = @_;
    my $res = $ua->get( $link )->result;
    my $keyword = $res->dom->at(".mt")->text;
    if ($keyword =~/1\/(\d+)/) { return $1; } 
    else 
{ printf "Failed to get max page code\n"; return undef }
}

sub try_to_get
{
    our ($ua);
    my ($link) = @_;
    my $res;
    my $times = 0;

    while (1)
    {
        try { $res = $ua->get( $link )->result; }
        catch { printf "Error %s, retry: %d\n", $_, $times; };
        $times++;
        last if (defined $res and $res->is_success);
        exit if ( $times > 5 );
    }
    return $res;
}

头像
523066680
Administrator
Administrator
帖子: 440
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 42 times
Been thanked: 70 times
联系:

Mojo::DOM 解析 HTML,提取正文

帖子 #2 523066680 » 2018年12月08日 08:30

提取正文的代码,Mojo::DOM 解析HTML,提取元素。
保存的文件名格式为 :作者+标题+诗歌类型+页面ID

代码: 全选

=info
    523066680
/vicyang
    2018
-12
=cut

use Mojo
::DOM;
use File::Slurp;
use Encode;
use File::Path;
use Try::Tiny;
use File::Basename qw/basename/;
use Win32API::File qw(:ALL);
STDOUT->autoflush(1);

our $src = "D:/temp/52shici_mobile";
our $dst = "D:/temp/52shici_extract";
my $item;
my (@files, %already, $pgname, $dirlist);
my ($rate, $prev);

for my $subdir ( glob "${src}/*" )
{
    printf "%s\n", $subdir;
    $item = basename($subdir);
    mkpath "${dst}/${item}" unless -"${dst}/${item}";

    # 需要处理的文件列表
    @files = glob "${subdir}/*";

    # 创建现有名单哈希表
    %already = ();
    my $dirlist = decode("utf16-le", `cmd /U /C dir /b \"${dst}/${item}\"`);
    grep { $_=~/(works_id=\d+)/; $already{$1} = 1; } split("\r\n", $dirlist);

    ($rate, $prev) = (0.0, 0.0);
    for my $id ( 0 .. $#files )
    {
        # 显示进度,百分率
        $rate = $id / $#files * 100.0;
        if ( ($rate-$prev) >= 1.0 ) {
            printf "%d\% ", $rate;
            $prev = $rate;
        }
        $pgname = basename($files[$id], ".html");
        next if exists $already{$pgname};
        abstract( "${dst}/${item}", $item, $files[$id] );
    }
    printf "\n";

    exit;
}

sub abstract
{
    my ($path, $item, $page) = @_;
    my $html = read_file( $page );
    $html=~s/\ //g;
    #$html=~s/<script>.*$//es;

    my $dom = Mojo::DOM->new( $html );
    my $buff = "";
    my ($fname, $head) = ("", "");
    my $id = basename($page, ".html");

    # 作者 标题 类型 日期
    my $author = $dom->at(".works-author a")->text;
    my $title  = $dom->at(".works-title")->text;
    my $type   = $dom->at(".works-type")->text;
    my $date   = $dom->at(".works-author")->text;

    $author =~s/^\s+//;  # 去掉开头space
    $date =~s/:/./g;
    $head  = join(" ", $author, $title, $type, $date );
    $fname = join(" ", $author, $title, $type, $id );
    #printf "%s %s\n", utf2gbk($fname), $page;

    $buff .= $head;
    $buff .= $dom->at("#content_box")->all_text;

    $buff=~s/\r?\n([ \t]+)?/#MARK/g;
    $buff=~s/ {2,}/ /sge;               # 合并连续空格
    $buff=~s/(#MARK){2,}/#MARK#MARK/g;  # 合并超过两行的换行
    $buff=~s/#MARK/\r\n/g;
    
    
#write_file( "${path}/${title}.txt", {binmode => ":raw"}, $buff );
    $path = decode('gbk', $path);
    $fname = decode('utf8', $fname);

    #去掉控制字符(某些文章标题就出现了<0x08>,<0x03>),并且是在Unicode编码下替换
    $fname =~s/\p{IsCntrl}//g;
    create_with_unicode_fname( $path, $fname, \$buff );
}

sub create_with_unicode_fname
{
    my ($path, $title, $buff) = @_;
    $title =~s/[\Q*?":<>|\\\/\E]/ /g;     # 去掉windows文件名敏感字符
    
$path .= "/". $title .".txt\0\0";  # 合并路径,追加 \0\0
    
$path = encode('utf16-le', $path);

    my 
$F = CreateFileW( $path, GENERIC_WRITE, 0, [], OPEN_ALWAYS, 0, 0);

    # 这里 FILE 句柄不支持 
$FILE 变量形式
    try {
        OsFHandleOpen(FILE, 
$F, "w") or die "Cannot open file";
    } catch { printf "
\nCan't create file: %s\n", encode('gbk', $title); return; };
    binmode FILE;
    print FILE $$buff;
    close(FILE);
}

sub utf2gbk { return encode('
gbk', decode('utf8', $_[0] )); }


处理结果:
提取后的诗词压缩 80MB 以内
http://523066680.ys168.com/
位置:临时/52shici

头像
523066680
Administrator
Administrator
帖子: 440
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 42 times
Been thanked: 70 times
联系:

Mojo::DOM 和 正则表达式提取效率对比

帖子 #3 523066680 » 2018年12月08日 08:32

提取效率对比:
固态硬盘,D:\Temp\52shici_mobile\爱恨情仇,8828 个文件
Mojo::DOM 提取 耗时 48秒,
正则表达式提取 耗时 12秒。

正则提取,普通硬盘,350156 个文件, 980秒


回到 “Perl”

在线用户

用户浏览此论坛: 没有注册用户 和 1 访客