[Perl][Mojo]查看Bathome论坛在线会员浏览状态

523066680

1. =info
   
2.     查看 bathome 在线会员浏览状态
   
3.     523066680@163.com
   
4.     2018-01
   
5. 
   
6.     * Version 0.5
   
7.       格式化对齐输出
   
8. =cut
   
9. 
   
10. use Modern::Perl;
    
11. use utf8;
    
12. use Encode;
    
13. use Mojo::UserAgent;
    
14. use List::Util qw/max/;
    
15. use Term::ReadKey;
    
16. STDOUT->autoflush(1);
    
17. 
    
18. our (@pages, @list, @maxlen);
    
19. our $main = "http://bbs.bathome.net/member.php?action=online&page=";
    
20. my ($ua, $res, $dom);
    
21. $ua = Mojo::UserAgent->new();
    
22. $ua = $ua->max_redirects(5);
    
23. 
    
24. get_pages( \@pages, $ua );
    
25. get_online_info( \@list, $_ ) for ( @pages );
    
26. 
    
27. #计算每列最大宽度
    
28. for my $col ( 0 .. $#{$list[0]} )
    
29. {
    
30.     push @maxlen, max( map { length($list[$_]->[$col]) } ( 0 .. $#list )  );
    
31. }
    
32. 
    
33. #输出
    
34. for my $e ( @list )
    
35. {
    
36.     for my $col ( 0 .. $#$e )
    
37.     {
    
38.         printf "%-${maxlen[$col]}s ", $e->[$col] ;   
    
39.     }
    
40.     printf "\n";
    
41. }
    
42. 
    
43. ReadKey -1;
    
44. 
    
45. sub get_online_info
    
46. {
    
47.     my ( $list, $dom ) = @_;
    
48.     my @ele;
    
49.     my $guest = encode('gbk', "游客");
    
50. 
    
51.     for my $e ( $dom->find("tr[class]")->each )
    
52.     {
    
53.         @ele = map { $_->all_text } $e->find('td')->each;
    
54.         @ele = map { s/\xa0//g; $_ } @ele; # remove  
    
55.         #push @$list, \@ele if ( $ele[0] !~/$guest/ );  # 会得到重复的结果
    
56.         push @$list, [@ele] if ( $ele[0] !~/$guest/ );
    
57.     }
    
58. }
    
59. 
    
60. sub get_pages
    
61. {
    
62.     my ( $pages, $ua ) = @_;
    
63.     my @pgcode;
    
64. 
    
65.     print "getting page: ", 1;
    
66.     $res = $ua->get( $main ."1" )->result;
    
67.     $dom = $res->dom;
    
68.     push @$pages, $res->dom;
    
69. 
    
70.     @pgcode = map { $_->text } $dom->at(".pages_btns")->find('a')->each;
    
71.     @pgcode = grep { /\d/ } @pgcode;  #只选择数字项
    
72. 
    
73.     for my $code ( @pgcode )
    
74.     {
    
75.         print ",", $code;
    
76.         push @$pages, $ua->get( $main .$code )->result->dom;
    
77.     }
    
78.     say "\n";
    
79. }

复制代码

排除游客状态，输出示例：

1. getting page: 1,2,3,4,5,6,7
   
2. 
   
3. 老刘1号, 18:03, 浏览帖子, VBS教程&资料, bat、vbs、js 原生混编
   
4. axuku, 18:02, 无效的越权访问, PowerShell原创&转载,
   
5. Ricky_520, 18:02, 回复主题, BAT求助&讨论, 小白求代编写：bat定期运行软件，在线 ...
   
6. pzjsu, 18:01, 无效的越权访问, VBS原创&转载,
   
7. 523066680, 17:59, 查看在线用户, ,
   
8. Hack38, 17:59, 浏览帖子, BAT求助&讨论, [分享]批处理实现windows下自动切换壁 ...
   
9. 13633425027, 17:59, 浏览帖子, BAT教程&资料, [批处理命令一日一教学]（6）复制文件 ...
   
10. yhcfsr, 17:56, 浏览论坛首页, ,
    
11. axrme, 17:55, 无效的越权访问, 出题挑战,

复制代码

更新，对齐

1. getting page: 1,2,3,4,5,6,7,8
   
2. 
   
3. 老刘1号  19:34 浏览论坛首页                                                               
   
4. tloye    19:32 提示信息/页面跳转 站务交流                                                
   
5. owlnp    19:32 无效的越权访问    开源原创工具                                             
   
6. WHY      19:32 浏览帖子          有偿求助         10元红包求助。                          
   
7. jwzgy    19:30 无效的越权访问    Python                                                   
   
8. lanwa    19:30 浏览帖子          第三方命令行     bat2exe工具Quick Batch File Compile ...
   
9. ykdqg    19:29 无效的越权访问    UNIX/Linux Shell                                         
   
10. fnrsn    19:28 无效的越权访问    第三方命令行                                             
    
11. 思想之翼 19:27 浏览帖子          BAT教程&资料     [系列教程]批处理for语句从入门到精通 ...

复制代码

523066680

1. =info
   
2.     查看 bathome 在线会员浏览状态
   
3.     523066680@163.com
   
4.     2018-01
   
5. 
   
6.     * Version 0.6
   
7.       格式化对齐输出
   
8.     * 分支 - 按会员/游客人数排列，会员优先
   
9. =cut
   
10. 
    
11. use Modern::Perl;
    
12. use utf8;
    
13. use Encode;
    
14. use Mojo::UserAgent;
    
15. use List::Util qw/max/;
    
16. use Term::ReadKey;
    
17. STDOUT->autoflush(1);
    
18. #system("mode con cols=100 lines=25");
    
19. 
    
20. our (@pages, @list, @maxlen);
    
21. our $main = "http://bbs.bathome.net/member.php?action=online&page=";
    
22. my ($ua, $res, $dom);
    
23. $ua = Mojo::UserAgent->new();
    
24. $ua = $ua->max_redirects(5);
    
25. 
    
26. get_pages( \@pages, $ua );
    
27. get_online_info( \@list, $_ ) for ( @pages );
    
28. 
    
29. #计算每列最大宽度
    
30. for my $col ( 0 .. $#{$list[0]} )
    
31. {
    
32.     push @maxlen, max( map { length($list[$_]->[$col]) } ( 0 .. $#list )  );
    
33. }
    
34. 
    
35. #按页面分类
    
36. my %hash;
    
37. my $topic;
    
38. my $guest = encode('gbk', "游客");
    
39. 
    
40. for my $e ( @list )
    
41. {
    
42.     $topic = $e->[4] || $e->[3] || $e->[2];
    
43.     unless ( exists $hash{$topic} )
    
44.     {
    
45.         $hash{$topic}{guest} = 0;
    
46.         $hash{$topic}{member} = [];
    
47.     }
    
48. 
    
49.     if ( $e->[0] eq $guest ) { $hash{$topic}{guest} ++ }
    
50.     else      { push @{$hash{$topic}{member}}, $e->[0] }
    
51. }
    
52. 
    
53. my @order =
    
54.     sort {
    
55.         $#{ $hash{$b}{member} } <=> $#{ $hash{$a}{member} }
    
56.             ||
    
57.         $hash{$b}{guest} <=> $hash{$a}{guest}
    
58.     } (keys %hash);
    
59. 
    
60. for my $topic ( @order )
    
61. {
    
62.     #say $topic;
    
63.     printf "%-${maxlen[4]}s  %s $guest, %s\n",
    
64.             $topic,
    
65.             $hash{$topic}{guest},
    
66.             join(", ", @{$hash{$topic}{member}})
    
67.             ;
    
68. }
    
69. 
    
70. ReadKey -1;
    
71. 
    
72. sub get_online_info
    
73. {
    
74.     my ( $list, $dom ) = @_;
    
75.     my @ele;
    
76.     my $guest = encode('gbk', "游客");
    
77. 
    
78.     for my $e ( $dom->find("tr[class]")->each )
    
79.     {
    
80.         @ele = map { $_->all_text } $e->find('td')->each;
    
81.         @ele = map { s/\xa0//g; $_ } @ele; # remove   
    
82.         #push @$list, \@ele if ( $ele[0] !~/$guest/ );  # 会得到重复的结果
    
83.         push @$list, [@ele];
    
84.     }
    
85. }
    
86. 
    
87. sub get_pages
    
88. {
    
89.     my ( $pages, $ua ) = @_;
    
90.     my @pgcode;
    
91. 
    
92.     print "getting page: ", 1;
    
93.     $res = $ua->get( $main ."1" )->result;
    
94.     $dom = $res->dom;
    
95.     push @$pages, $res->dom;
    
96. 
    
97.     @pgcode = map { $_->text } $dom->at(".pages_btns")->find('a')->each;
    
98.     @pgcode = grep { /\d/ } @pgcode;  #只选择数字项
    
99. 
    
100.     for my $code ( @pgcode )
     
101.     {
     
102.         print ",", $code;
     
103.         push @$pages, $ua->get( $main .$code )->result->dom;
     
104.     }
     
105.     say "\n";
     
106. }

复制代码

已注册会员人数多的排前面，游客人数多的紧跟在会员之后

1. getting page: 1,2,3,4,5,6,7,8
   
2. 
   
3. 开源原创工具                              0 游客, fnrsn, fangzong954m
   
4. 查看在线用户                              3 游客, 523066680
   
5. iBAT                                      0 游客, agatecoder
   
6. 批处理&VBS|JS混编（注释混编法）           0 游客, 慕夜蓝化
   
7. 浏览论坛首页                              21 游客,
   
8. 提示信息/页面跳转                         6 游客,
   
9. BAT求助&讨论                              6 游客,
   
10. Perl 绘制3D模型文件 - 斯坦福兔子 (p ...   3 游客,
    
11. cmd中能不能显示出文件夹大小的？           3 游客,
    
12. 批处理如何在txt文本指定字符后添加回 ...   2 游客,
    
13. [已解决]批处理如何将文本中的三列内容 ...  2 游客,
    
14. 批处理大小写字母转换                      2 游客,

复制代码

将  
    $topic = $e->[4] || $e->[3] || $e->[2];
改为
    $topic = $e->[3] || $e->[2];
即可按板块列出

1. 浏览论坛首页               12 游客, 523066680
   
2. BAT求助&讨论               125 游客,
   
3. 第三方命令行               9 游客,
   
4. BAT原创&转载               9 游客,
   
5. 新手练功                   7 游客,
   
6. 提示信息/页面跳转          7 游客,
   
7. BAT教程&资料               7 游客,
   
8. VBS求助&讨论               6 游客,
   
9. 出题挑战                   4 游客,
   
10. 回到论坛                   4 游客,
    
11. PowerShell教程&资料        3 游客,

复制代码