写了个定时刷新咱们版块的脚本，但是有问题，帮忙解惑下，谢谢！

scrit

最近事情不太多，加上每天打开网页去看论坛有些繁琐，尝试着写一个脚本去定时刷新perl版块帖子的更新情况，知道format可以格式化输出，但是在我做完后，发现有些地方，自己始终做不好，把源代码贴出来，请大家指教一下，

1. #!/usr/bin/perl
   
2. use strict;
   
3. use LWP::Simple qw(get);
   
4. 
   
5. my $min = `date +%M`;
   
6. chomp $min;
   
7. my $now_min = -1;
   
8. my $pinlv = 1;
   
9. while(1)
   
10. {
    
11. $min =`date +%M`;
    
12. chomp $min;
    
13. 
    
14. if($now_min != $min && !($min%$pinlv) )
    
15. {
    
16.   $now_min = $min;
    
17.   my $URL="http://bbs.chinaunix.net/forum-25-1.html";
    
18.   my $html =get($URL);
    
19.   my @array = split("\n",$html);
    
20.   my @arrray_for_out;
    
21.   my @aa = &check_title(@array);
    
22.   sleep(1);
    
23.   &format_print(@aa);
    
24. }
    
25. else
    
26.   {
    
27. sleep(5);
    
28.   }
    
29. 
    
30. 
    
31. 
    
32. }
    
33. 
    
34. sub check_title
    
35. {
    
36. my @array = @_;
    
37. my @array_for_out;
    
38. my $flag = 0;
    
39. my $flag1 = 0;
    
40. my $tag = 0;
    
41. my $tag1 = 0;
    
42. my $titleurl;
    
43. my $titlename;
    
44. my $author;
    
45. my $writedate;
    
46. my $last_replay;
    
47. my $replaytime;
    
48. my $readnum;
    
49. my $replaynum;
    
50. open FH, ">","Temp.txt";
    
51. for(@array)
    
52. {
    
53. #    my $line = $_;
    
54.    if(/\<div width=\"0\" height="0" id=\"cuad_69/)
    
55.    {
    
56.       $flag = 1
    
57.    }
    
58.   if($flag eq 1 && /span id=.*?a href=\"(.*?)\"\>(.*?)\</)
    
59.     {
    
60.      $titleurl=$1;
    
61.      $titleurl = "http://bbs.chinaunix.net/".$titleurl;
    
62.       $titlename = $2;
    
63.     push @array_for_out,$titleurl ;
    
64.     push @array_for_out,$titlename;
    
65.      $tag=1;
    
66.     }
    
67.   if($flag eq 1  && $tag eq 1 && /a href=.*?>(.*?)\<\/a\>$/)
    
68.     {
    
69.      $author = $1;
    
70.      push @array_for_out, $author;
    
71.      $flag1= 1;
    
72.     }
    
73. if($flag eq 1 && $tag eq 1 && $flag1 eq 1 && /\<cite\>(\d+\-\d+\-\d+)\</)
    
74.    {
    
75.     $writedate=$1;
    
76.     push @array_for_out, $writedate;   
    
77.    }
    
78. if($flag eq 1 && $tag eq 1 && $flag1 eq 1 && /^\<\w+\s+\w+=.\w+.\>\<strong\>(\d+)\<\/strong\>\<\/td\>$/)
    
79.    {
    
80.     $replaynum = $1;
    
81.     push @array_for_out,$replaynum;
    
82.    }
    
83. if($flag eq 1 && $tag eq 1 && $flag1 eq 1 && /bgcolor=.*?strong\>(\d+)\<\/strong\>\<\/td\>$/)
    
84.    {
    
85.    $readnum = $1;
    
86.    push @array_for_out, $readnum;
    
87.    }
    
88. 
    
89. if($flag eq 1 && $tag eq 1 && $flag1 eq 1 && /cite.*?a href\=.*?\>(.*?)\</)
    
90.   {
    
91.    $last_replay = $1;
    
92.    chomp $last_replay;
    
93.    push @array_for_out, $last_replay;
    
94.    $tag1 = 1;
    
95.   }
    
96. if($flag eq 1 && $tag eq 1 && $flag1 eq 1 &&  $tag1 eq 1 && /em.*?a href=.*?\>(.*?)\</ && !(/清除 Cookies\<\/a\>/))
    
97.   {
    
98.   $replaytime = $1;
    
99.   push @array_for_out,$replaytime;
    
100.   print FH "$titlename\△$author\△$writedate\△$replaynum\△$readnum\△$last_replay\△$replaytime\△$titleurl\n";
     
101.   }
     
102. }
     
103. close FH;
     
104. return @array_for_out;
     
105. }
     
106. 
     
107. 
     
108. sub format_print
     
109. {
     
110.   my $tt=`date +%T`;
     
111. chomp $tt;
     
112. print "$tt\t";
     
113. my ($tname,$author,$wdate,$replaynum,$readnum,$last_replay,$updatetime,$url);
     
114. open FD ,"<Temp.txt";
     
115. while(<FD>)
     
116. {
     
117. ($tname,$author,$wdate,$replaynum,$readnum,$last_replay,$updatetime,$url) = split("\△",$_);
     
118. $^ = 'STDOUT_TOP';
     
119. $~ = 'STDOUT';
     
120. $= = 31;
     
121. $| = 1;
     
122. write;
     
123. }
     
124. 
     
125. 
     
126. format STDOUT_TOP =
     
127. @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
     
128. "Page $%"
     
129.                                 Net Title
     
130.   Name                Author    Date     R/RTimes last_replay  updatetime     URL
     
131. ---------------------------------------------------------------------------------------------
     
132. .
     
133. 
     
134. format STDOUT =
     
135. @<<<<<<<<<<<<<<<<<<< @||||||| @<<<<<<<<<@>>>>@<<<< @|||||||| @<<<<<<<<<< @||||||||||||||||||||| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<
     
136. $tname,                $author, $wdate, $replaynum."/"$readnum, $last_replay ,  $updatetime ,                       $url
     
137. .
     
138. 
     
139. }
     
140. 
     
141. 
     

复制代码

执行后，输出的结果是这样的

14:52:47                                                                                                 Page 1
                                Net Title
  Name                Author    Date     R/RTimes last_replay  updatetime     URL
---------------------------------------------------------------------------------------------
perl如何得到一个字符 better03 2010-12-16   0/8     better033 2010-12-16  http://bbs.chinaunix.n
这个算不算bug         paktc   2010-12-16   7/126     toniz   2010-12-16  http://bbs.chinaunix.n
在这里发个招聘贴找人 weiweijh 2010-12-15   6/160   liyangole 2010-12-16  http://bbs.chinaunix.n
Mail::IMAPClient读ou yaoliwei 2010-12-16   1/26    yaoliwei  2010-12-16  http://bbs.chinaunix.n
茴字的多种写法 -- 论 兰花仙子 2009-12-01  59/15357   2gua    2010-12-16  http://bbs.chinaunix.n
不明白这个Magic Perl cinanine 2010-12-16   5/161     toniz   2010-12-16  http://bbs.chinaunix.n
[求助]修改文件内容   haijunze 2010-12-16   4/75    haijunzen 2010-12-16  http://bbs.chinaunix.n
字符怎么相加？         solu   2010-12-16   6/111    昭襄王   2010-12-16  http://bbs.chinaunix.n
Magic Perl Code!     deathcul 2003-06-03   7/1791  liyangole 2010-12-16  http://bbs.chinaunix.n
Perl变量作用域[PDF下 兰花仙子 2006-02-03  30/7565    2gua    2010-12-16  http://bbs.chinaunix.n
获取文件所在目录     liuyifan 2010-12-15   5/146    99超人   2010-12-16  http://bbs.chinaunix.n
学习引用竟然可以引用 tsie_che 2010-12-16   3/176    guap514  2010-12-16  http://bbs.chinaunix.n
求助：windows下安装C liuyifan 2010-12-13   2/163   liuyifang 2010-12-15  http://bbs.chinaunix.n
tcl命名空间有个问题?kingkick 2010-12-15   1/86     zhlong8  2010-12-15  http://bbs.chinaunix.n
在linux 下安装mod_pe jackson6 2010-12-12  15/335   兰花仙子  2010-12-15  http://bbs.chinaunix.n
美国上市当当网信招聘 dangdang 2010-12-14   5/305    kingwmj  2010-12-15  http://bbs.chinaunix.n
如何通过perl修改类似 wangyl19 2010-12-14   4/190     ulmer   2010-12-15  http://bbs.chinaunix.n
win32::api 启动windo lgq_101  2010-12-15   5/116   黑色阳光_ 2010-12-15  http://bbs.chinaunix.n
请问这个正则表达式该 regonly1 2010-12-10  18/545   langren86 2010-12-15  http://bbs.chinaunix.n
Perl UDP Server 如何  r_zack  2010-12-15   5/115    r_zack   2010-12-15  http://bbs.chinaunix.n
perl 网络编程        jiannma  2010-12-15   2/185   兰花仙子  2010-12-15  http://bbs.chinaunix.n
请各位大侠帮忙解决一 忧郁蓝黑 2010-12-15   1/85    兰花仙子  2010-12-15  http://bbs.chinaunix.n
急急急，perl脚本使用 cnmtchbg 2010-12-15   4/147   langren86 2010-12-15  http://bbs.chinaunix.n
在perl 中调用oracle  jackson6 2010-12-14   5/171   兰花仙子  2010-12-15  http://bbs.chinaunix.n
读取文件创建散列的问 sai9924  2010-12-14   6/184     wfnh    2010-12-15  http://bbs.chinaunix.n
mason 里怎么实现url?jackson6 2010-12-14   2/153     yiten   2010-12-15  http://bbs.chinaunix.n
从一个Perl程序看网络 兰花仙子 2010-12-08  29/3335    scrit   2010-12-15  http://bbs.chinaunix.n



这里url没有显示全，请教各位指正一下，因为学习perl不久，所以想听听别人的想法。

kingwmj

perl
还有这作用，同问。

liyangole

先研究研究，一直对这方面比较欠缺。

scrit

等待高人给我解惑啦，我发现我的代码有许多地方感觉写的效率不好，  给我指出来啊，谢谢啦

scrit

等待高人给我解惑啦，我发现我的代码有许多地方感觉写的效率不好，  给我指出来啊，谢谢啦

paktc

我也很菜……  连模块都不会用，内牛满面  
借 wget 下载页面
我在win, 列出前20个标题，并且标题字符长的话会被截取。

1. 
   
2. 
   
3. while (1) {
   
4. sleep 5;
   
5. system("wget -O main.txt http://bbs.chinaunix.net/forum-25-1.html 2>nul");
   
6. 
   
7. open READ,"<main.txt";
   
8. 
   
9. $act=0;
   
10. $top=0;
    
11. print "Top20:\n"."="x70 ."\n";
    
12. while (<READ>) {
    
13.     if ($act==1 and $top<20) {
    
14.        if (/span id="thread/) {
    
15.            if (/\.html"?>(.+)<\/a>/) {
    
16.                 $top++;
    
17.                 $title=substr($1,0,20);
    
18.                 printf "%-25s",$title;
    
19.                 undef @a;
    
20.                 while (! defined $a[3]) {
    
21.                    $tmp=<READ>;
    
22.                    if ($tmp=~/uid.+>(.+)</i) {$a[1]=$1;}
    
23.                    if ($tmp=~/cite>(.+)</i) {$a[2]=$1;}
    
24.                    if ($tmp=~/strong>(\d+)</i) {$a[3]=$1;}
    
25.                 }
    
26.                 while (! defined $a[6]) {
    
27.                    $tmp=<READ>;
    
28.                    if ($tmp=~/strong>(\d+)</i) {$a[4]=$1;}
    
29.                    if ($tmp=~/html">(.+)<\/a><\/cite>/i) {$a[5]=$1;}
    
30.                    if ($tmp=~/lastpost">(.+)<\/a><\/em>/i) {$a[6]=$1;}
    
31.                 }
    
32.                 printf "%-15s$a[2] $a[3]/$a[4] $a[5]\n",$a[1];
    
33.            }
    
34.        }
    
35.     }
    
36.     if (/<!-- 广告结束 -->/) {$act=1;}
    
37. }
    
38. }
    

复制代码

Top20:
======================================================================
写了个定时刷新咱们版     scrit          2010-12-16 5/105 paktc
glob in scalar conte     atiking        2010-12-16 2/53 atiking
看看这名use是编译时?    maxxfire       2010-12-16 7/113 兰花仙子
Mail::IMAPClient读ou     yaoliwei       2010-12-16 2/52 ulmer
perl如何得到一个字符     better0332     2010-12-16 5/102 better0332
文件锁应用-请教          peking_A_Liang 2010-12-16 0/10 peking_A_Liang
求助map的问题            nfwolf         2010-12-16 1/17 黑色阳光_cu
美国上市当当网信招聘     dangdang0000   2010-12-14 7/344 DQP
神奇的substr左值用法     黑色阳光_cu    2010-12-16 4/91 phoenix_perl
远程连接MySQL的问题      renzuguo       2010-12-16 0/22 renzuguo
在这里发个招聘贴找人     weiweijh       2010-12-15 7/190 xnkjdx1998
不明白这个Magic Perl     cinanine       2010-12-16 6/190 kingwmj
字符怎么相加？           solu           2010-12-16 7/141 kingwmj
这个算不算bug            paktc          2010-12-16 11/211 kingwmj
茴字的多种写法 -- 论     兰花仙子       2009-12-01 60/15405 kingwmj
发个招聘贴               yikexiaocao    2010-12-09 54/7571 边边赚
關於Audrey_Tang的一?    JCheung        2010-12-16 2/80 wxlfh
[求助]修改文件内容       haijunzeng     2010-12-16 4/101 haijunzeng
Magic Perl Code!         deathcult      2003-06-03 7/1814 liyangole
Perl变量作用域[PDF下     兰花仙子       2006-02-03 30/7576 2gua

scrit

回复 6# paktc


   你写的比我的简洁很多，但是好像这个不全，我执行后有错误，而且我也想在后面显示帖子的URL的

perlw01f

试试HTML::TreeBuilder::XPath
格式输出 printf

scrit

回复 8# perlw01f


    嗯，我试试去，以前没了解过这个模块

iamlimeng

URL是格式化输出时被截短了

check_title写得过于复杂，其实几行正则就OK了