#!/usr/bin/perl								#
#
#		YZBBS3000->LB5000在線轉(zhuǎn)換程序				#
#									#
#		編制：hleil(hleil@163.com)				#
#	http://www.hleil.cn.gs/cgi-bin/LeoBoard/leoboard.cgi		#
#		http://hleil.126.com					#
#									#
#適用于原來申請了別人的免費的Yuzi論壇3000(BBS3000)，現(xiàn)在又建設(shè)了自己的LB5000論壇	#
#的情況。也就是說，你無法直接控制Yuzi論壇的數(shù)據(jù)，只可以瀏覽。這樣就無法使用清涼編制的	#
#兩個轉(zhuǎn)換程序（bbs2lbt,ys2lbt）和山鷹編制的bbs2lb5000。			#
#									#
#因為我有自己的需要，所以就寫了這么個小東西，呵呵，這可是我第一次寫perl腳本，請大家多	#
#提意見！									#
#									#
#使用了清涼的t2t,如果有錯誤，修改成#111那樣。					#
#使用了libwww-perl，如果你的虛擬主機不支持，可以在本機運行。我就是這樣的。		#
#（平臺：NT+ActivePerl）。然后把生成的文件打包上載，用webunzip解開，這樣不會出現(xiàn)權(quán)	#
#限問題，webunzip從此處下載：						#
#http://www.tapor.com/webunzip/						#
#									#
#									#
#測試平臺：NT+ActivePerl-5.6.0.623(沒辦法，主機不支持libwww-perl)		#
#									#
#完成日期：2001-12-3							#
#########################################################################
#
#推薦使用方法：用lb5000建一個論壇，類別：精華區(qū)。
#執(zhí)行此腳本。

#如果你的BBS已經(jīng)有了很多用戶，為了避免重名，可以給$rusername變量加上適當(dāng)?shù)那熬Y或者后綴，
#此名稱不受LB5000的用戶名長度限制。

#如果你想在現(xiàn)有論壇執(zhí)行轉(zhuǎn)化，首先關(guān)閉lb5000，然后，手工給$j賦一個值，大小是你現(xiàn)有主貼子
#號+1。

#
#做完之后，重新整理論壇就行。
#
#此論壇：http://www.hleil.cn.gs/cgi-bin/LeoBoard/forums.cgi?forum=5
#就是用這個腳本轉(zhuǎn)換的。
#當(dāng)然，用戶資料是無法轉(zhuǎn)化的。

#假設(shè)你申請的免費Yuzi論壇的
#URL=http://www.test.com/cgi-bin/bbs3000/bbs.cgi?id=200112022043
#
#則：$base="http://www.test.com/cgi-bin/bbs3000/list/200112022043/
#
$base="http://www.test.com/cgi-bin/bbs3000/list/200112022043/";

#這就不用說了吧？你的LB5000論壇的絕對目錄，注意設(shè)置 777 屬性
$lbpath="/web/htdoc/hleil/cgi-bin/LeoBoard/forum5/";

#$lbpath="";	#NT用此
##############################################################
####以下不需修改
####
use Time::Local;
require "data/styles.cgi";
$bbsdata="bbs";
####GET 主貼
$tmp="$base$bbsdata";
$data=&gethtml("$tmp");
$num=length($data)/16;
#
&save;
sub save{
for($i=0,$j=1;$i<$num;$i++,$j++){
	$bbsdata=substr($data,$i*16,16);
	$tmp="$base$bbsdata";
	$data2=&gethtml("$tmp");
	($rtitles,$rthistime,$rusername,$nr,$rfrom,$rhasreply,$emote,$lastname,$rlasttime,$re,$rhassee)=split(/\t/,$data2);
	$ctime=&t2t($rthistime);
#        print FILE "$newthreadnumber\t$intopictitle\t$intopicdescription\topen\t0\t0\t$inmembername\t$currenttime\t\t$currenttime\t$inposticon\t$inposttemp\t";
#        print FILE "$inmembername\t$intopictitle\t$postipaddress\t$inshowemoticons\t$inshowsignature\t$currenttime\t$inpost\t$inposticon\t";
	$inposttemp = &lbhz($nr,24);#$maxsavepost);
	open (FILE,">$lbpath$j.pl");
	print FILE "$j\t$rtitles\t\topen\t$rhasreply\t$rhassee\t$rusername\t$ctime\t\t$ctime\t\t$inposttemp\t";
	close FILe;
	open (FILE,">$lbpath$j.thd.cgi");
	print FILE "$rusername\t$rtitles\t$rfrom\tyes\tyes\t$ctime\t$nr\t\t";
	close FILe;
	if ($rhasreply > 0)
	{
	&save2($j,$re);
	}
}}
sub save2{
$mainid=$_[0];
$nextid=$_[1];
$tmp="$base$nextid";
@data2=&gethtml("$tmp");
foreach $m (@data2){
	chomp($m);
	if($m ne ""){
	($rtime,$rthistime,$rusername,$rcomment,$rfrom,$remote,$retitles,$rerhassee)=split(/\t/,$m);
	$ctime=&t2t($rthistime);
	open (FILE,">>$lbpath$mainid.thd.cgi");
	print FILE "\n$rusername\t$retitles\t$rfrom\tyes\tyes\t$ctime\t$rcomment\t\t";
	close FILe;
}}

	open (FILE,"$lbpath$mainid.pl");
	$data3 = <FILE>;
	close FILE;
        ($topicid, $topictitle, $topicdescription, $threadstate, $threadposts ,$threadviews, $startedby, $startedpostdate, $lastposter, $lastpostdate, $posticon, $inposttemp) = split(/\t/,$data3);
	$lastposter=$rusername;
	$lastpostdate=$ctime;
	$inposttemp = &lbhz($nr,24);
	open (FILE,">$lbpath$mainid.pl");
        print FILE "$topicid\t$topictitle\t$topicdescription\t$threadstate\t$threadposts\t$threadviews\t$startedby\t$startedpostdate\t$lastposter\t$lastpostdate\t$posticon\t$inposttemp\t";
	close FILE;
}
sub gethtml {
 $url=$_[0];
 require LWP::UserAgent; 
 $ua = new LWP::UserAgent; 
 $request = new HTTP::Request('GET', "$url"); 
 $response = $ua->request($request); 
 my $html = $response->{_content}; 
 return $html;
}
sub lbhz{
my($str,$maxlen) = @_;
if (length($str) <= $maxlen){    return $str;    }
if (substr($str,0,$maxlen-4) =~ /^([\000-\177]|[\200-\377][\200-\377])*([\000-\177]|[\200-\377][\200-\377])$/ ){
return substr($str,0,$maxlen-4)." ...";
}else{
return substr($str,0,$maxlen-5)."　...";
}
}
sub t2t{
#轉(zhuǎn)換之前的日期格式為2001/04/28(13:04:04)，
#我的是：2001-08-10.19:00:54，一樣，呵呵~~
#其他的日期如果具備這幾項內(nèi)容,按照格式對下面時間的定位做一些修改，就可以用這個函數(shù)
	my $ntime=shift;
	my($secn,$minn,$hourn,$dayn,$monn,$yearn);
	$yearn=substr($ntime,0,4); $monn=substr($ntime,5,2); $dayn=substr($ntime,8,2);
	$hourn=substr($ntime,11,2); $minn=substr($ntime,14,2); $secn=substr($ntime,17,2);
	$yearn=int($yearn)-1900;
#	$yearn=int($yearn)-1900;
	$monn=dotime($monn)-1;
	$dayn=dotime($dayn);
	$hourn=dotime($hourn);
	$minn=dotime($minn);
	$secn=dotime($secn);
	$time = timelocal($secn,$minn,$hourn,$dayn,$monn,$yearn);
#111	$time = timelocal($secn,$minn,$hourn,$dayn,$monn,101);
	return $time;
}
sub dotime {
	my $dtime=shift;
	$dtime=substr($dtime,1,1) if(substr($dtime,0,1) eq "0");
	$dtime=int($dtime);
	$dtime=1 if($dtime<1);
	return $dtime;
}