[Perl][Mojo]查看Bathome论坛在线会员浏览状态(页 1) - Perl - 批处理之家 BAT,CMD,批处理,PowerShell,VBS,DOS

523066680 发表于 2018-1-30 18:07

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

[i=s] 本帖最后由 523066680 于 2018-1-30 19:40 编辑 [/i]

[code]=info
查看 bathome 在线会员浏览状态
523066680@163.com
2018-01

* Version 0.5
   格式化对齐输出
=cut

use Modern::Perl;
use utf8;
use Encode;
use Mojo::UserAgent;
use List::Util qw/max/;
use Term::ReadKey;
STDOUT->autoflush(1);

our (@pages, @list, @maxlen);
our $main = "http://bbs.bathome.net/member.php?action=online&page=";
my ($ua, $res, $dom);
$ua = Mojo::UserAgent->new();
$ua = $ua->max_redirects(5);

get_pages( \@pages, $ua );
get_online_info( \@list, $_ ) for ( @pages );

#计算每列最大宽度
for my $col ( 0 .. $#{$list[0]} )
{
push @maxlen, max( map { length($list[$_]->[$col]) } ( 0 .. $#list )  );
}

#输出
for my $e ( @list )
{
for my $col ( 0 .. $#$e )
{
      printf "%-${maxlen[$col]}s ", $e->[$col] ;
}
printf "\n";
}

ReadKey -1;

sub get_online_info
{
my ( $list, $dom ) = @_;
my @ele;
my $guest = encode('gbk', "游客");

for my $e ( $dom->find("tr[class]")->each )
{
      @ele = map { $_->all_text } $e->find('td')->each;
      @ele = map { s/\xa0//g; $_ } @ele; # remove  
      #push @$list, \@ele if ( $ele[0] !~/$guest/ );  # 会得到重复的结果
      push @$list, [@ele] if ( $ele[0] !~/$guest/ );
}
}

sub get_pages
{
my ( $pages, $ua ) = @_;
my @pgcode;

print "getting page: ", 1;
$res = $ua->get( $main ."1" )->result;
$dom = $res->dom;
push @$pages, $res->dom;

@pgcode = map { $_->text } $dom->at(".pages_btns")->find('a')->each;
@pgcode = grep { /\d/ } @pgcode;  #只选择数字项

for my $code ( @pgcode )
{
      print ",", $code;
      push @$pages, $ua->get( $main .$code )->result->dom;
}
say "\n";
}[/code]排除游客状态，输出示例：[code]getting page: 1,2,3,4,5,6,7

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

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

523066680 发表于 2018-1-31 15:25

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

[i=s] 本帖最后由 523066680 于 2018-1-31 15:40 编辑 [/i]

[code]=info
查看 bathome 在线会员浏览状态
523066680@163.com
2018-01

* Version 0.6
   格式化对齐输出
* 分支 - 按会员/游客人数排列，会员优先
=cut

use Modern::Perl;
use utf8;
use Encode;
use Mojo::UserAgent;
use List::Util qw/max/;
use Term::ReadKey;
STDOUT->autoflush(1);
#system("mode con cols=100 lines=25");

our (@pages, @list, @maxlen);
our $main = "http://bbs.bathome.net/member.php?action=online&page=";
my ($ua, $res, $dom);
$ua = Mojo::UserAgent->new();
$ua = $ua->max_redirects(5);

get_pages( \@pages, $ua );
get_online_info( \@list, $_ ) for ( @pages );

#计算每列最大宽度
for my $col ( 0 .. $#{$list[0]} )
{
push @maxlen, max( map { length($list[$_]->[$col]) } ( 0 .. $#list )  );
}

#按页面分类
my %hash;
my $topic;
my $guest = encode('gbk', "游客");

for my $e ( @list )
{
$topic = $e->[4] || $e->[3] || $e->[2];
unless ( exists $hash{$topic} )
{
      $hash{$topic}{guest} = 0;
      $hash{$topic}{member} = [];
}

if ( $e->[0] eq $guest ) { $hash{$topic}{guest} ++ }
else    { push @{$hash{$topic}{member}}, $e->[0] }
}

my @order =
sort {
      $#{ $hash{$b}{member} } <=> $#{ $hash{$a}{member} }
         ||
      $hash{$b}{guest} <=> $hash{$a}{guest}
} (keys %hash);

for my $topic ( @order )
{
#say $topic;
printf "%-${maxlen[4]}s  %s $guest, %s\n",
         $topic,
         $hash{$topic}{guest},
         join(", ", @{$hash{$topic}{member}})
         ;
}

ReadKey -1;

sub get_online_info
{
my ( $list, $dom ) = @_;
my @ele;
my $guest = encode('gbk', "游客");

for my $e ( $dom->find("tr[class]")->each )
{
      @ele = map { $_->all_text } $e->find('td')->each;
      @ele = map { s/\xa0//g; $_ } @ele; # remove
      #push @$list, \@ele if ( $ele[0] !~/$guest/ );  # 会得到重复的结果
      push @$list, [@ele];
}
}

sub get_pages
{
my ( $pages, $ua ) = @_;
my @pgcode;

print "getting page: ", 1;
$res = $ua->get( $main ."1" )->result;
$dom = $res->dom;
push @$pages, $res->dom;

@pgcode = map { $_->text } $dom->at(".pages_btns")->find('a')->each;
@pgcode = grep { /\d/ } @pgcode;  #只选择数字项

for my $code ( @pgcode )
{
      print ",", $code;
      push @$pages, $ua->get( $main .$code )->result->dom;
}
say "\n";
}[/code][b]已注册会员人数多的排前面，游客人数多的紧跟在会员之后[/b][code]getting page: 1,2,3,4,5,6,7,8

开源原创工具                            0 游客, fnrsn, fangzong954m
查看在线用户                            3 游客, 523066680
iBAT                                     0 游客, agatecoder
批处理&VBS|JS混编（注释混编法）          0 游客, 慕夜蓝化
浏览论坛首页                            21 游客,
提示信息/页面跳转                      6 游客,
BAT求助&讨论                            6 游客,
Perl 绘制3D模型文件 - 斯坦福兔子 (p ... 3 游客,
cmd中能不能显示出文件夹大小的？          3 游客,
批处理如何在txt文本指定字符后添加回 ... 2 游客,
[已解决]批处理如何将文本中的三列内容 ...  2 游客,
批处理大小写字母转换                   2 游客,[/code]将
$topic = $e->[4] || $e->[3] || $e->[2];
改为
$topic = $e->[3] || $e->[2];
即可按板块列出[code]浏览论坛首页             12 游客, 523066680
BAT求助&讨论             125 游客,
第三方命令行             9 游客,
BAT原创&转载             9 游客,
新手练功                7 游客,
提示信息/页面跳转       7 游客,
BAT教程&资料             7 游客,
VBS求助&讨论             6 游客,
出题挑战                4 游客,
回到论坛                4 游客,
PowerShell教程&资料       3 游客, [/code]

页: [1]

批处理之家's Archiver

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

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