珞珈山水BBS -- 单文区文章阅读

搜索

单文区文章阅读 [返回]
发信人: zoei@smth.org (无尽的爱), 信区: BBSDev 标题: 一个用perl写的抓BBS文章的方法发信站: BBS 水木清华站 (Tue Jun 10 01:39:36 2003) 转信站: WHUBBS!news.tiaozhan.com!maily.cic.tsinghua.edu.cn!SMTH 把BHQT的Linux版抓下来的办法。以前写的。可以拿来玩玩开一个新版，然后用bbs用户执行这个脚本就行了。基本思想是先抓一个版面文章的叶面，找出所有文章的连接，然后挨个抓抓到每一篇文章后找出自己需要的部分，写入成文件，修改DIR文件。有一个BUG.就是发信人没有处理好。 #!/usr/bin/perl -w use LWP::Simple; use HTML::Parse; use HTML::Element; use URI::URL; $old_time=time(); $html = get "http://bbs.dlut.edu.cn/cgi-bin/bbsdoc?board=LinuxUnix&go=A&style=1"; $parsed_html = HTML::Parse::parse_html($html); for (@{ $parsed_html->extract_links(("a")) }) { $link = $_->[0]; $url = new URI::URL $link; $full_url = $url->abs("http://bbs.dlut.edu.cn"); @topic_url = grep /bbscon/,$full_url; if(@topic_url == 1) { print "$topic_url[0]\n"; $html = get $topic_url[0]; while($old_time==time()){;}; $old_time=time(); #抓的时间太快了，分辨不了。所以等 $filename="M.".time().".A"; $username="bendany"; #生成新的文件。然后处理一下。 open("TEXT",">".$filename) \|\| die "Write file: $!"; binmode(TEXT); $_=$html; s/<[^>]>//g; # 去掉<>网页标记 s/>/>/g; s/</</g; s/[^.]LinuxUnix\]//g; # 去掉头 s/^\s+//g; # 去掉前导空格和换行 s/分类[^>]//g; # 去掉尾 s/\s+$//g; # 去掉后导空格和换行 print TEXT; close("TEXT"); #找标题 open("TEXT",$filename) \|\| die "Write file: $!"; @titlename=grep s/标题: //,<TEXT>; @titlename=grep s/\s+$//,$titlename[0]; open("TEMP",">.TEMP") \|\| die "Open TEMP file: $!"; binmode(TEMP); $buffer="\0" x 256; print TEMP $buffer; seek(TEMP,0,0); print TEMP $filename; seek(TEMP,78,0); print TEMP "LL"; seek(TEMP,80,0); print TEMP $username; seek(TEMP,160,0); print TEMP @titlename; close("TEMP"); open("TEMP",".TEMP") \|\| die "Open TEMP file: $!"; open("DIR",">>.DIR") \|\| die "Open DIR file: $!"; binmode(DIR); print DIR <TEMP>; close("DIR"); } } -- ◢───────────────╮╭╬╮ 日一二三四五六 -┬─┬-╮ ║ 人总是人 ║╭╬╮ 31 1 2 ╔──╗║ ║ 不可能完美无缺 ║╭╬╮ 3 4 5 6 7 8 9 │ 三 │║ ║ 便如那天上明月 ║╭╬╮ 10 11 12 13 14 15 16 │ 月 │║ ║ 永远有盈亏一般 ║╭╬╮ 17 18 19 20 21 22 23 ╚──╝║ ╰───────────────╯╭╬╮ 24 25 26 27 28 29 30 ────◤ ※ 修改:·zoei 于 Jun 10 01:39:35 修改本文·[FROM: 202.118.75.64] ※ 来源:·BBS 水木清华站 smth.org·[FROM: 202.118.75.64]
[返回单文区目录]

单文区文章阅读 [返回]

发信人: zoei@smth.org (无尽的爱), 信区: BBSDev
标  题: 一个用perl写的抓BBS文章的方法
发信站: BBS 水木清华站 (Tue Jun 10 01:39:36 2003)
转信站: WHUBBS!news.tiaozhan.com!maily.cic.tsinghua.edu.cn!SMTH

把BHQT的Linux版抓下来的办法。以前写的。可以拿来玩玩
开一个新版，然后用bbs用户执行这个脚本就行了。

基本思想是先抓一个版面文章的叶面，找出所有文章的连接，然后挨个抓
抓到每一篇文章后找出自己需要的部分，写入成文件，修改DIR文件。

有一个BUG.就是发信人没有处理好。

#!/usr/bin/perl -w
use LWP::Simple;
use HTML::Parse;
use HTML::Element;
use URI::URL;
$old_time=time();
$html = get "http://bbs.dlut.edu.cn/cgi-bin/bbsdoc?board=LinuxUnix&go=A&style=1";
$parsed_html = HTML::Parse::parse_html($html);
for (@{ $parsed_html->extract_links(("a")) }) {
        $link = $_->[0];
        $url = new URI::URL $link;
        $full_url = $url->abs("http://bbs.dlut.edu.cn");
        @topic_url = grep /bbscon/,$full_url;
        if(@topic_url == 1)
        {
                print "$topic_url[0]\n";
                $html = get $topic_url[0];
                while($old_time==time()){;};
                $old_time=time(); #抓的时间太快了，分辨不了。所以等
                $filename="M.".time().".A";
                $username="bendany";

                #生成新的文件。然后处理一下。
                open("TEXT",">".$filename) || die "Write file: $!";
                binmode(TEXT);
                $_=$html;
                s/<[^>]*>//g;           # 去掉<>网页标记
                s/>/>/g;
                s/</</g;
                s/[^.]*LinuxUnix\]//g;          # 去掉头
                s/^\s+//g;                      # 去掉前导空格和换行
                s/分类*[^>]*//g;                # 去掉尾
                s/\s+$//g;                      # 去掉后导空格和换行
                print TEXT;
                close("TEXT");

                #找标题
                open("TEXT",$filename) || die "Write file: $!";
                @titlename=grep s/标  题: //,<TEXT>;
                @titlename=grep s/\s+$//,$titlename[0];

                open("TEMP",">.TEMP") || die "Open TEMP file: $!";
                binmode(TEMP);

                $buffer="\0" x 256;
                print TEMP $buffer;
                seek(TEMP,0,0);
                print TEMP $filename;
                seek(TEMP,78,0);
                print TEMP "LL";
                seek(TEMP,80,0);
                print TEMP $username;
                seek(TEMP,160,0);
                print TEMP @titlename;
                close("TEMP");

                open("TEMP",".TEMP") || die "Open TEMP file: $!";
                open("DIR",">>.DIR") || die "Open DIR file: $!";
                binmode(DIR);
                print DIR <TEMP>;
                close("DIR");
        }
}
--
◢───────────────╮╭╬╮ 日  一  二  三  四  五  六 -┬─┬-╮
║           人总是人           ║╭╬╮ 31                   1   2 ╔──╗║
║        不可能完美无缺        ║╭╬╮  3   4   5   6   7   8   9 │ 三 │║
║        便如那天上明月        ║╭╬╮ 10  11  12  13  14  15  16 │ 月 │║
║        永远有盈亏一般        ║╭╬╮ 17  18  19  20  21  22  23 ╚──╝║
╰───────────────╯╭╬╮ 24  25  26  27  28  29  30 ────◤

※ 修改:·zoei 于 Jun 10 01:39:35 修改本文·[FROM:   202.118.75.64]
※ 来源:·BBS 水木清华站 smth.org·[FROM: 202.118.75.64]

[返回单文区目录]