>>$1<\/a>/g;
$FORM{'MESSAGE'} =~ s/<\/?r>//g;
}
#==================================================
# 情報の修正
#==================================================
{
# UNICODE置き換え
$FORM{'mail'} =~ s/[x0-9a-fA-F;]+/&;/g;
$FORM{'subject'} =~ s/[x0-9a-fA-F;]+/&;/g;
if ($SETTING{'BBS_UNICODE'} ne "pass"){
$FORM{'FROM'} =~ s/[x0-9a-fA-F;]+/&;/g;
$FORM{'MESSAGE'} =~ s/[x0-9a-fA-F;]+/?/g;
}
# 1行データからは改行を削ります
$FORM{'FROM'} =~ s/
//g;
$FORM{'mail'} =~ s/
//g;
$FORM{'subject'} =~ s/
//g;
# デカ文字対策
$FORM{'FROM'} =~ s/"/"/g;
$FORM{'mail'} =~ s/"/"/g;
$FORM{'subject'} =~ s/"/"/g;
##$FORM{'mail'} =~ s/ //g;
# 末尾にsjisの1バイト目があったら削る
my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
my $check2 = '[\201-\237\340-\374]';
$FORM{'FROM'} =~ s/($check1)$check2$/$1/g;
$FORM{'mail'} =~ s/($check1)$check2$/$1/g;
$FORM{'subject'} =~ s/($check1)$check2$/$1/g;
$FORM{'MESSAGE'} =~ s/($check1)$check2$/$1/g;
# mail欄にpreと入れるとを、teletypeと入れるとを挿入
if ($FORM{'mail'} =~ /pre/) {
$FORM{'MESSAGE'} = "$FORM{'MESSAGE'}
";
$FORM{'MESSAGE'} =~ s/
/
/g;
} elsif ($FORM{'mail'} =~ /teletype/) {
$FORM{'MESSAGE'} = "$FORM{'MESSAGE'}";
}
}
#==================================================
# ID・IP表示
#==================================================
{
if ($FORM{'mail'} ne '' && $SETTING{'BBS_FORCE_ID'} ne "checked") {
$ID = " ID:???";
}
if ($SETTING{'BBS_ADMIN_NAME'} && $FLAG{'cap'} =~ /$SETTING{'BBS_ADMIN_NAME'}/) {
$ID = " ID:$SETTING{'BBS_ADMIN_ID'}";
}
if ($SETTING{'BBS_NO_ID'} ne "checked") {
$DATE .= $ID;
}
if ($SETTING{'BBS_DISP_IP'} eq "checked") {
$DATE .=" [ $HOST ]";
}
}
#==================================================
# ファイル操作(サブジェクトファイル読み込み)
#==================================================
{
use vars qw(@PAGEFILE);
use vars qw(%SUBJECT);
use vars qw($FILENUM);
my ($subtt,$subtm,$subval,$subnum);
my ($file, $value, $filename);
my $subject = $PATH . "subject.txt";
my $keyfile = $FORM{'key'} . ".dat";
undef $subtm;
undef $subtt;
# サブジェクトファイルを読み込む
open(SUBR,"<$subject");
eval{flock(SUBR,1);};
foreach(){
chop;
($file, $value) = split /<>/;
unless($file){next;}
$filename = $DATPATH . $file;
if(-e $filename){ # datが存在する場合順番に追加
push(@PAGEFILE,$file);
$SUBJECT{$file} = $value;
}
}
eval{flock(SUBR,8);};
close(SUBR);
# サブジェクト数を取得
$FILENUM=@PAGEFILE;
if($FORM{'subject'}){$FILENUM++;}
# ログを定数に揃える
if($FILENUM > $KEEPLOGCOUNT){
for(my $start=$KEEPLOGCOUNT;$start<$FILENUM;$start++){
my ($key,$delfile);
$delfile = $DATPATH . $PAGEFILE[$start];
unlink($delfile);
$key = $PAGEFILE[$start];
$key =~ s/([^\.]*)\.dat/$1/;
$delfile = $TEMPPATH . $key . ".html";
unlink($delfile);
}
$FILENUM = $KEEPLOGCOUNT;
my @temp;
@temp = @PAGEFILE[0..$FILENUM];
undef @PAGEFILE;
@PAGEFILE = @temp;
}
# サブジェクトが存在するか?
unless($FORM{'subject'}){ # 無い場合
# データファイルがあるか検証
unless(-e "$DATPATH$keyfile"){
DispError("ERROR!","ERROR:該当スレッドがありません!");
}
$subval = $FLAG{'subject'};
$subnum = $FLAG{'subnum'};
$subnum++;
# if($subnum > 999){$subnum++;}
}else{
# サブジェクトがある場合それは新規スレッドである・・
$subval = $FORM{'subject'};
$subnum = 1;
}
# レス数とdat容量が規定値を超えていたらレス数を+1する
my $datafile = $DATPATH . $FORM{'key'} . ".dat";
if ($subnum > ($SETTING{'BBS_MAX_RES_COUNT'} - 1)) {$subnum++;}
if (-s "$datafile" >= ($SETTING{'BBS_MAX_RES_SIZE'} * 1024)) {$subnum++;}
$subtt = "$subval ($subnum)";
$subtm = "$keyfile<>$subtt";
# サブジェクトハッシュを書き換える
$SUBJECT{$keyfile}=$subtt;
#スレの1と現在のメール欄からデフォルトのモードを判定
unless ($FORM{'subject'}) {
open (MODE,"../$FORM{'bbs'}/dat/$FORM{'key'}.dat");
my @LOG = ;
close (MODE);
my $mailcom = (split /<>/,$LOG[0])[1];
undef @LOG;
if ($mailcom =~/hane/) {$FLAG{'submode'} = 'hane';}
elsif ($mailcom =~/kage/) {$FLAG{'submode'} = 'kage';}
elsif ($mailcom =~/sage/) {$FLAG{'submode'} = 'sage';}
elsif ($mailcom =~/dame/) {$FLAG{'submode'} = 'dame';}
else {$FLAG{'submode'} = '';}
}
if ($FORM{'mail'} =~/^age/) {$FLAG{'submode'} = '';}
elsif ($FORM{'mail'} =~/hane/) {$FLAG{'submode'} = 'hane';}
elsif ($FORM{'mail'} =~/kage/) {$FLAG{'submode'} = 'kage';}
elsif ($FORM{'mail'} =~/sage/) {$FLAG{'submode'} = 'sage';}
elsif ($FORM{'mail'} =~/dame/) {$FLAG{'submode'} = 'dame';}
# サブジェクトテキストを開く
{
my $newsub;
$newsub = "";
# haneのときは適当な場所に飛ばす
if ($FLAG{'submode'} eq 'hane') {
my (@temp,$random);
srand;
$random = int(rand (@PAGEFILE - 1));
foreach(@PAGEFILE){
if(@temp == $random){
$temp[@temp]=$keyfile;
$newsub .= "$subtm\n";
}
if($_ ne $keyfile){
$temp[@temp]=$_;
$newsub .= "$_<>$SUBJECT{$_}\n";
}
}
@PAGEFILE=@temp;
# kageのときは真ん中に持ってくる
} elsif ($FLAG{'submode'} eq 'kage') {
my (@temp,$middle);
$middle = int(@PAGEFILE / 2);
foreach(@PAGEFILE){
if(@temp == $middle){
$temp[@temp]=$keyfile;
$newsub .= "$subtm\n";
}
if($_ ne $keyfile){
$temp[@temp]=$_;
$newsub .= "$_<>$SUBJECT{$_}\n";
}
}
@PAGEFILE=@temp;
# sageの時は上がらない
} elsif ($FORM{'subject'} eq "" && $FLAG{'submode'} eq 'sage') {
foreach(@PAGEFILE){
$newsub .= "$_<>$SUBJECT{$_}\n";
}
# dameの時は一番下に移す
} elsif ($FLAG{'submode'} eq 'dame') {
my @temp;
foreach(@PAGEFILE){
if($_ ne $keyfile){
$temp[@temp]=$_;
$newsub .= "$_<>$SUBJECT{$_}\n";
}
}
$temp[@temp]=$keyfile;
$newsub .= "$subtm\n";
@PAGEFILE=@temp;
# それ以外は全てage(一番上に移す)
} else {
my @temp;
$temp[0]=$keyfile;
$newsub = "$subtm\n";
foreach(@PAGEFILE){
# 上がるキーは一番最初に持ってくる
# keyfileは現在書き込みしたスレッドキー(上がっている)
if($_ ne $keyfile){
$temp[@temp]=$_;
$newsub .= "$_<>$SUBJECT{$_}\n";
}
}
@PAGEFILE=@temp;
}
#一括書き込み(板飛び対策入り)
# 読み書きモードでオープン
open(SUBW,"+<$subject");
eval{flock(SUBW,2);};
# ファイルポインタを先頭に
seek(SUBW, 0, 0);
print SUBW $newsub;
# 新ファイルサイズを出力
eval{truncate(SUBW, tell(SUBW));};
# (念のため)ロック解除はクローズ処理任せに
# eval{flock(SUBW,8);};
close(SUBW);
}
# i-mode用テキストを開く
{
unless(-e $IMODEPATH){
mkdir($IMODEPATH,0777);
}
my $imodeindex = $IMODEPATH . "index.html";
open(SUBW,">$imodeindex");
eval{flock(SUBW,2);};
# 一括書き込み
print SUBW "\n";
print SUBW "\n";
print SUBW "$SETTING{'BBS_TITLE'}\n";
print SUBW "\n";
print SUBW "おんぷちゃんねる i-mode トップ
";
print SUBW "$SETTING{'BBS_TITLE'}
";
my ($count,$key,$end,$subtitle);
if($FILENUM<30){$end=$FILENUM;}else{$end=30;}
for($count=1;$count<=$end;$count++){
@PAGEFILE[$count-1]=~ /(\d*)\.dat/;
$key = $1;
$subtitle = $SUBJECT{@PAGEFILE[$count-1]};
&jcode::z2h_sjis(\$subtitle);
print SUBW "$count: $subtitle
";
}
$count=@PAGEFILE;
if ($count > 30){
print SUBW "
次\n";
}
print SUBW "
\n";
print SUBW <
タイトル:
名前:
mail:
コメント
EOF
print SUBW "