Board logo

标题: [原创代码] [Perl][Mojo]查看Bathome论坛在线会员浏览状态 [打印本页]
作者: 523066680    时间: 2018-1-30 18:07     标题: [Perl][Mojo]查看Bathome论坛在线会员浏览状态

本帖最后由 523066680 于 2018-1-30 19:40 编辑 
  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    时间: 2018-1-31 15:25     标题: 更新 - 按帖子在浏览人数以及会员人数排列

本帖最后由 523066680 于 2018-1-31 15:40 编辑 
  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 游客, 
复制代码




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2