Perl - 抓取文学网站文章

[523066680]

分两步，第一步抓取HTML到本地，第二部提取HTML到明文

Code: [全选] [展开/折叠] [Download] (get_HTML.pl)

1. =info
2.     523066680/vicyang
3.     2018-10
4. =cut
5.  
6. use utf8;
7. use Encode;
8. use LWP::UserAgent;
9. use File::Path;
10. use File::Slurp;
11. use File::Basename qw/basename/;
12. use Mojo::DOM;
13. STDOUT->autoflush(1);
14.  
15. our $wdir = encode('gbk', "D:/temp/力成文学");
16. mkpath $wdir unless -e $wdir;
17. our $main = "http://www.ceasm.com";
18. our $ua = LWP::UserAgent->new( keep_alive => 1, timemout => 8 );
19. my $res = $ua->get($main);
20. my $html = $res->content();
21. my $dom = Mojo::DOM->new($html);
22.  
23. my ($url, $dir, $buff, $item );
24. my (@sUrl, @sItem, @list, $article);
25.  
26. # 一级栏目
27. for my $e ( $dom->at(".menu")->find("[target]")->each )
28. {
29.     $url = $e->attr("href");
30.     $item = $e->text;
31.     printf "%s\n", $e->text;
32.  
33.     # 二级栏目
34.     get_subitem( $url, \@sUrl, \@sItem );
35.     for my $id ( 0 .. $#sUrl )
36.     {
37.         printf "    %s\n", $sItem[$id];
38.         $dir = "${wdir}/${item}/${sItem[$id]}/";
39.         mkpath $dir unless -e $dir;
40.  
41.         # 所有文章链接
42.         @list = list( $main . $sUrl[$id] );
43.         for my $link ( @list )
44.         {
45.             printf "        %s\n", $link;
46.             $buff = article($main . $link);
47.             write_file( $dir . basename($link), $buff );    
48.         }
49.     }
50. }
51.  
52. # 二级栏目
53. sub get_subitem
54. {
55.     my ( $url, $links, $names ) = @_;
56.     my $res = $ua->get( $url );
57.     $dom = Mojo::DOM->new( $res->content() );
58.     @$links = map { $_->attr("href") } ( $dom->at(".keywords")->find("[target]")->each );
59.     @$names = map { $_->text } ( $dom->at(".keywords")->find("[target]")->each );
60. }
61.  
62. # 文段列表
63. sub list
64. {
65.     my $link = shift;
66.     my $res = $ua->get( $link );
67.     $dom = Mojo::DOM->new( $res->content() );
68.     # 获取最大页面值
69.     $dom->at(".pagelist")->find("a")->last =~ /(\d+)/;
70.     my $max = $1;
71.     my @list;
72.  
73.     for my $id ( 1 .. $max )
74.     {
75.         $res = $ua->get( $link ."list${id}.html" );
76.         $dom = Mojo::DOM->new( $res->content() );
77.         push @list, map { $_->attr("href") } $dom->at(".dedelist")->find("h4 [target]")->each;
78.     }
79.  
80.     return @list;
81. }
82.  
83. sub article
84. {
85.     my $link = shift;
86.     my $res;
87.     do {  $res = $ua->get( $link ); } until ( length($res->content) > 2000 );
88.  
89.     return $res->content;
90. }

文章提取以及导出

Code: [全选] [展开/折叠] [Download] (HTML_to_Text.pl)

1. =info
2.     523066680/vicyang
3.     2018-10
4. =cut
5.  
6. use utf8;
7. use Encode;
8. use File::Slurp;
9. use LWP::UserAgent;
10. use Mojo::DOM;
11. STDOUT->autoflush(1);
12.  
13. our $main = "http://www.ceasm.com";
14. our $ua = LWP::UserAgent->new( keep_alive => 1, timemout => 8 );
15. our $wdir = encode('gbk', "D:/Temp/力成文学");
16. chdir $wdir or warn "$!";
17.  
18. my $buff;
19. my @files;
20. my @dirs = `dir "$wdir" /ad /s /b`;
21. grep { s/\r?\n//; } @dirs;
22.  
23. for my $dir ( @dirs )
24. {
25.     printf "%s\n", $dir;
26.     chdir $dir or die "$!";
27.     @files = glob "*.html";
28.     next unless $#files >= 0;
29.     $buff = "";
30.     grep { $buff .= article( $_ ) } sort { substr($b, 0, -5) <=> substr($a, 0, -5) } @files;
31.     write_file( "${dir}.txt", $buff );
32. }
33.  
34. sub article
35. {
36.     my $file = shift;
37.     my $html = decode('gbk', scalar(read_file( $file )) );
38.     $html =~s/&nbsp;/#CRLF/g;
39.     $html =~s/\n/#CRLF/g;                     # ------> 1
40.  
41.     $dom = Mojo::DOM->new( $html );
42.     my $title = $dom->at("h2")->all_text;
43.     my $text  = $dom->at(".text")->all_text;
44.  
45.     $text =~s/\s//g;                          # ------> 2 去掉所有空白符号包括 space tab \r \n 全角空白符
46.     $text =~s/(\d+、)/\n$1/g;
47.     $text =~s/\Q$title\E//;
48.     $text =~s/#CRLF/\n/g;
49.     $text =~s/[\r\n]+/\n/g;
50.     $text =~s/^\n//;
51.  
52.     my $str;
53.     #标题
54.     $str  = sprintf "%s\n", encode('gbk', $title );
55.     $str .= sprintf "%s\n", $file;
56.     $str .= sprintf "%s\n\n", encode('gbk', $text);
57.     return $str;
58. }
59.  
60. sub xcode
61. {
62.     $_[1]='x' if (not defined $_[1]);
63.  
64.     for my $v ( split(//,$_[0]) )
65.     {
66.         print sprintf ("%02$_[1] ",ord($v));    
67.     }
68.     print "\n\n";
69. }

[zzz19760225]

ε=(´ο｀*)))唉，只能默默的摸摸代码的头，然后继续该睡觉睡觉。

[523066680]

ε=(´ο｀*)))唉，只能默默的摸摸代码的头，然后继续该睡觉睡觉。

哇，论坛挂了两个月，想不到还有人过来光顾，真不容易。

也不知道是不是服务商要搞我，说访问流量超过了，把网站给关了，还建议升级VPS。 明明没多少人访问来着。

[zzz19760225]

哇，论坛挂了两个月，想不到还有人过来光顾，真不容易。

也不知道是不是服务商要搞我，说访问流量超过了，把网站给关了，还建议升级VPS。 明明没多少人访问来着。

专业方向，加上个体兴趣加成，内涵蛮多的。
只是看看，没办法入手，浪费时间，急啊（心里还要不住的说，稳住稳住）！
----------------------------------------------------------
也许那位云流量账号的测试造成的吧，
要不就是杀熟，该宰几只了，放些血，解解渴。
跟百度搞到后面所谓的商业化一样。

[523066680]

专业方向，加上个体兴趣加成，内涵蛮多的。
只是看看，没办法入手，浪费时间，急啊（心里还要不住的说，稳住稳住）！
----------------------------------------------------------
也许那位云流量账号的测试造成的吧，
要不就是杀熟，该宰几只了，放些血，解解渴。
跟百度搞到后面所谓的商业化一样。

话说你关注/从事哪个方向？

[zzz19760225]

话说你关注/从事哪个方向？

[/quote]

关注：
最好是直接从GB18030汉字标准为计算机指令集的机器硬件制作， （国产开关逻辑门或其他实现可能，保持长期稳定生长）
其次是一个硬件中间过渡的GB18030类汉字标准实现，
最后是底层硬件软件接口部分的实现。
（不知道行业外门外汉的理解表达，这样算表达好了没有）

用这些内容做的小玩具，类似过去的小霸王学习机，做成计算器和手掌机玩，最好能简单联网的增加乐趣。