[Programming] pttget.pl

備份~ 抓 ptt 上面文章的 perl script (從 kenwu 那邊修改的，好像有點小問題，我也忘了~)

#!/usr/bin/perl
#
# PTT BBS Board Crawler BETA 3, Powered By LiloHuang
# http://blog.roodo.com/kenwu/
# 使用 GPL V2 釋出擷取文章功能部份程式
# Last Updated: 2007/09/02
#
# Fix: 修正 guest無法登入問題
#

$|=1;
use strict;
use Net::Telnet;
use Time::HiRes qw(usleep);

system("title KUSO PTT BBS Board Crawler BETA 3");
print "########################################\n";
print "# KUSO PTT BBS Board Crawler BETA 3 #\n";
print "# Powered By LiloHuang #\n";
print "# http://blog.roodo.com/kenwu/ #\n";
print "########################################\n\n";
print "說明: 這是一個可以將 PTT BBS看板進行抓取的程式...\n";
print " 目前仍在測試階段, 還有許\多Bug與不穩定...\n";
print " 僅供測試使用, 切莫用於非法用途侵權他人文章!!\n\n";

my $host;
print "站台: \n";
print " 1. ptt.cc\n";
print " 2. ptt2.cc\n";
print "請選擇: ";
my $site = 1; #;
chomp $site;
$host = ($site eq '1'?"ptt.cc":"ptt2.cc");
mkdir("./$host") unless(-d "./$host/");
print "\nBBS 帳號: ";
my $id = "我的帳號"; #;
chomp $id;
&except("沒有輸入帳號, 程式即將關閉.") if($id eq '');
print "BBS 密碼: ";
my $pass = "我的密碼"; #;
chomp $pass;
print "看板名稱: ";
my $board = "Sodagreen"; #;
chomp $board;
&except("沒有輸入看板名稱, 程式即將關閉.") if($board eq '');
print "起始文章編號: ";
my $start = 8435; #;
chomp $start;
&except("沒有輸入起始編號, 程式即將關閉.") if($start eq '');
print "結束文章編號: ";
my $end = 8436; #;
chomp $end;
&except("沒有輸入結束編號, 程式即將關閉.") if($end eq '');
&except("結束編號 < 起始編號, 邏輯錯誤, 程式即將關閉.") if($end<$start);

my $num = $end - $start + 1;
my $esc = chr(27);
my @stack;
my $buf;
my $cnt;
my $bot;
my $rec = 0;
my $bar = '─'x39;

my %login = (
"請輸入代號" => "$id\n",
"請輸入您的密碼" => "$pass\n",
"您想刪除其他重複的" => "N\n",
"錯誤嘗試" => "\n",
"任意鍵" => "\n",
"酸甜苦辣板" => "q",
"鴻雁往返" => "q"
);

my %board = (
"任意鍵" => "\n",
);

print "\n正在登入 $host...";
&build;
while( $buf = &get ) {
if($buf =~/由於人數過多，請您稍後再來。/) {
print "線上人數過多, 自動重新連線第 ".sprintf("%3d",++$rec)." 次\r";
$bot->close;
&build;
}
&except("目前已有太多 guest 在站上") if($buf =~/目前已有太多 guest 在站上/);
&except("這裡沒有這個人啦!") if($buf =~/這裡沒有這個人啦/);
&except("密碼不對喔") if($buf =~/密碼不對喔/);
last if($buf =~/.+目前坊裡有.+?$/);
foreach (keys %login) {
&put($login{$_}) if($buf=~/$_/);
}
}
print "Done!\n";

print "進入 $board 看板...";
&put("s");
usleep(1000);
&put("$board\n");
while( $buf = &get ) {
last if($buf =~/文章選讀/);
foreach (keys %login) {
&put($login{$_}) if($buf=~/$_/);
}
}
print "Done!\n\n";

$cnt = 0;
&put("$start\n\n");

mkdir("./$host/$board") unless(-d "./$host/$board/");

while( $buf = &get ) {
last if($buf =~/文章選讀/);
push(@stack, $buf);
print "正在擷取第 ".sprintf("%3d",($cnt+1))." 篇文章...\r";
unless( $buf !~ /\Q (100%)\E/)
{
&callback($start+$cnt);
undef @stack;
last if ++$cnt==$num;
}
&put(".");
}
print "\n\n總共 $cnt 文章擷取完畢\n\n";
$bot->close;
system("PAUSE");

sub callback {
open(FH,">./$host/$board/$_[0].ans");
my @out_buffer;
my $pos = 0;
for(my $i=0;$i<=$#stack;$i++) {
my @tmp = split(/\n/, $stack[$i]);
$tmp[0]=~s/^$esc\[H$esc\[J/$i==0?"":"\n"/e;
my $linetag = pop @tmp;
if($i > 0 && $i==$#stack) {
if($i < 2) {
if($linetag=~/目前顯示: 第 (\d+)~(\d+) 行/) {
my $rexp_s = $1;
$rexp_s = $rexp_s - 1 if($stack[$i]=~/$esc\[36m$bar$esc\[m/);
foreach(@tmp) {
s/$esc\[\d+;\d+H/\n/;
$out_buffer[$rexp_s++] = $_;
}
}
}else{
shift(@tmp) if($i>0);
foreach(@tmp) {
s/$esc\[\d+;\d+H/\n/;
$out_buffer[$pos++] = $_;
}
}
}else{
shift(@tmp) if($i>0);
foreach(@tmp) {
$out_buffer[$pos++] = $_;
}
}
}

foreach(@out_buffer) {
s/$esc\[K//g;
s/\r/\n/g;
print FH $_;
}
close(FH);
}

sub put {
$bot->put($_[0]);
usleep(200000);
}

sub get {
usleep(200000);
return $bot->get( Timeout => 10000 );
}

sub error {
print "網路連線逾時或程式發生異常, 程式即將關閉!\n\n";
system("PAUSE");
$bot->close;
exit;
}

sub except {
print "$_[0]\n\n";
system("PAUSE");
exit;
}

sub build {
$bot = new Net::Telnet (
Port => 23,
Timeout => 30,
Errmode => \&error
);
$bot->open($host);
}