[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

本帖最后由 523066680 于 2018-1-30 19:40 编辑
  1. =info
  2.     查看 bathome 在线会员浏览状态
  3.     523066680@163.com
  4.     2018-01
  5.     * Version 0.5
  6.       格式化对齐输出
  7. =cut
  8. use Modern::Perl;
  9. use utf8;
  10. use Encode;
  11. use Mojo::UserAgent;
  12. use List::Util qw/max/;
  13. use Term::ReadKey;
  14. STDOUT->autoflush(1);
  15. our (@pages, @list, @maxlen);
  16. our $main = "http://bbs.bathome.net/member.php?action=online&page=";
  17. my ($ua, $res, $dom);
  18. $ua = Mojo::UserAgent->new();
  19. $ua = $ua->max_redirects(5);
  20. get_pages( \@pages, $ua );
  21. get_online_info( \@list, $_ ) for ( @pages );
  22. #计算每列最大宽度
  23. for my $col ( 0 .. $#{$list[0]} )
  24. {
  25.     push @maxlen, max( map { length($list[$_]->[$col]) } ( 0 .. $#list )  );
  26. }
  27. #输出
  28. for my $e ( @list )
  29. {
  30.     for my $col ( 0 .. $#$e )
  31.     {
  32.         printf "%-${maxlen[$col]}s ", $e->[$col] ;   
  33.     }
  34.     printf "\n";
  35. }
  36. ReadKey -1;
  37. sub get_online_info
  38. {
  39.     my ( $list, $dom ) = @_;
  40.     my @ele;
  41.     my $guest = encode('gbk', "游客");
  42.     for my $e ( $dom->find("tr[class]")->each )
  43.     {
  44.         @ele = map { $_->all_text } $e->find('td')->each;
  45.         @ele = map { s/\xa0//g; $_ } @ele; # remove  
  46.         #push @$list, \@ele if ( $ele[0] !~/$guest/ );  # 会得到重复的结果
  47.         push @$list, [@ele] if ( $ele[0] !~/$guest/ );
  48.     }
  49. }
  50. sub get_pages
  51. {
  52.     my ( $pages, $ua ) = @_;
  53.     my @pgcode;
  54.     print "getting page: ", 1;
  55.     $res = $ua->get( $main ."1" )->result;
  56.     $dom = $res->dom;
  57.     push @$pages, $res->dom;
  58.     @pgcode = map { $_->text } $dom->at(".pages_btns")->find('a')->each;
  59.     @pgcode = grep { /\d/ } @pgcode;  #只选择数字项
  60.     for my $code ( @pgcode )
  61.     {
  62.         print ",", $code;
  63.         push @$pages, $ua->get( $main .$code )->result->dom;
  64.     }
  65.     say "\n";
  66. }
复制代码
排除游客状态,输出示例:
  1. getting page: 1,2,3,4,5,6,7
  2. 老刘1号, 18:03, 浏览帖子, VBS教程&资料, bat、vbs、js 原生混编
  3. axuku, 18:02, 无效的越权访问, PowerShell原创&转载,
  4. Ricky_520, 18:02, 回复主题, BAT求助&讨论, 小白求代编写:bat定期运行软件,在线 ...
  5. pzjsu, 18:01, 无效的越权访问, VBS原创&转载,
  6. 523066680, 17:59, 查看在线用户, ,
  7. Hack38, 17:59, 浏览帖子, BAT求助&讨论, [分享]批处理实现windows下自动切换壁 ...
  8. 13633425027, 17:59, 浏览帖子, BAT教程&资料, [批处理命令一日一教学](6)复制文件 ...
  9. yhcfsr, 17:56, 浏览论坛首页, ,
  10. axrme, 17:55, 无效的越权访问, 出题挑战,
复制代码
更新,对齐
  1. getting page: 1,2,3,4,5,6,7,8
  2. 老刘1号  19:34 浏览论坛首页                                                               
  3. tloye    19:32 提示信息/页面跳转 站务交流                                                
  4. owlnp    19:32 无效的越权访问    开源原创工具                                             
  5. WHY      19:32 浏览帖子          有偿求助         10元红包求助。                          
  6. jwzgy    19:30 无效的越权访问    Python                                                   
  7. lanwa    19:30 浏览帖子          第三方命令行     bat2exe工具Quick Batch File Compile ...
  8. ykdqg    19:29 无效的越权访问    UNIX/Linux Shell                                         
  9. fnrsn    19:28 无效的越权访问    第三方命令行                                             
  10. 思想之翼 19:27 浏览帖子          BAT教程&资料     [系列教程]批处理for语句从入门到精通 ...
复制代码
1

评分人数

更新 - 按帖子在浏览人数以及会员人数排列

本帖最后由 523066680 于 2018-1-31 15:40 编辑
  1. =info
  2.     查看 bathome 在线会员浏览状态
  3.     523066680@163.com
  4.     2018-01
  5.     * Version 0.6
  6.       格式化对齐输出
  7.     * 分支 - 按会员/游客人数排列,会员优先
  8. =cut
  9. use Modern::Perl;
  10. use utf8;
  11. use Encode;
  12. use Mojo::UserAgent;
  13. use List::Util qw/max/;
  14. use Term::ReadKey;
  15. STDOUT->autoflush(1);
  16. #system("mode con cols=100 lines=25");
  17. our (@pages, @list, @maxlen);
  18. our $main = "http://bbs.bathome.net/member.php?action=online&page=";
  19. my ($ua, $res, $dom);
  20. $ua = Mojo::UserAgent->new();
  21. $ua = $ua->max_redirects(5);
  22. get_pages( \@pages, $ua );
  23. get_online_info( \@list, $_ ) for ( @pages );
  24. #计算每列最大宽度
  25. for my $col ( 0 .. $#{$list[0]} )
  26. {
  27.     push @maxlen, max( map { length($list[$_]->[$col]) } ( 0 .. $#list )  );
  28. }
  29. #按页面分类
  30. my %hash;
  31. my $topic;
  32. my $guest = encode('gbk', "游客");
  33. for my $e ( @list )
  34. {
  35.     $topic = $e->[4] || $e->[3] || $e->[2];
  36.     unless ( exists $hash{$topic} )
  37.     {
  38.         $hash{$topic}{guest} = 0;
  39.         $hash{$topic}{member} = [];
  40.     }
  41.     if ( $e->[0] eq $guest ) { $hash{$topic}{guest} ++ }
  42.     else      { push @{$hash{$topic}{member}}, $e->[0] }
  43. }
  44. my @order =
  45.     sort {
  46.         $#{ $hash{$b}{member} } <=> $#{ $hash{$a}{member} }
  47.             ||
  48.         $hash{$b}{guest} <=> $hash{$a}{guest}
  49.     } (keys %hash);
  50. for my $topic ( @order )
  51. {
  52.     #say $topic;
  53.     printf "%-${maxlen[4]}s  %s $guest, %s\n",
  54.             $topic,
  55.             $hash{$topic}{guest},
  56.             join(", ", @{$hash{$topic}{member}})
  57.             ;
  58. }
  59. ReadKey -1;
  60. sub get_online_info
  61. {
  62.     my ( $list, $dom ) = @_;
  63.     my @ele;
  64.     my $guest = encode('gbk', "游客");
  65.     for my $e ( $dom->find("tr[class]")->each )
  66.     {
  67.         @ele = map { $_->all_text } $e->find('td')->each;
  68.         @ele = map { s/\xa0//g; $_ } @ele; # remove   
  69.         #push @$list, \@ele if ( $ele[0] !~/$guest/ );  # 会得到重复的结果
  70.         push @$list, [@ele];
  71.     }
  72. }
  73. sub get_pages
  74. {
  75.     my ( $pages, $ua ) = @_;
  76.     my @pgcode;
  77.     print "getting page: ", 1;
  78.     $res = $ua->get( $main ."1" )->result;
  79.     $dom = $res->dom;
  80.     push @$pages, $res->dom;
  81.     @pgcode = map { $_->text } $dom->at(".pages_btns")->find('a')->each;
  82.     @pgcode = grep { /\d/ } @pgcode;  #只选择数字项
  83.     for my $code ( @pgcode )
  84.     {
  85.         print ",", $code;
  86.         push @$pages, $ua->get( $main .$code )->result->dom;
  87.     }
  88.     say "\n";
  89. }
复制代码
已注册会员人数多的排前面,游客人数多的紧跟在会员之后
  1. getting page: 1,2,3,4,5,6,7,8
  2. 开源原创工具                              0 游客, fnrsn, fangzong954m
  3. 查看在线用户                              3 游客, 523066680
  4. iBAT                                      0 游客, agatecoder
  5. 批处理&VBS|JS混编(注释混编法)           0 游客, 慕夜蓝化
  6. 浏览论坛首页                              21 游客,
  7. 提示信息/页面跳转                         6 游客,
  8. BAT求助&讨论                              6 游客,
  9. Perl 绘制3D模型文件 - 斯坦福兔子 (p ...   3 游客,
  10. cmd中能不能显示出文件夹大小的?           3 游客,
  11. 批处理如何在txt文本指定字符后添加回 ...   2 游客,
  12. [已解决]批处理如何将文本中的三列内容 ...  2 游客,
  13. 批处理大小写字母转换                      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 游客,
复制代码
1

评分人数

TOP

返回列表