## Last updated: "Sat, 21 Sep 2002 04:38:51 JST-9"
# Bbs.pm written by (8桁:◆sUY48rs.)(10桁:◆OHsUY48rs.) 2002
package Bbs;
push @INC, './Bbs';
require 5.004;
use strict;
#use Fcntl;

#perlmodを参考にした定数スカラーの宣言
use vars qw($_BBS_STATUS_NOERROR $_BBS_STATUS_CAUTION $_BBS_STATUS_ERROR $_BBS_STATUS_NOTICE $_BBS_STATUS_COOKIE);
# 0:エラーなし 1:注意 2:致命的なエラー 3:書き込み確認 4:cookie確認
*_BBS_STATUS_NOERROR	= \0;
*_BBS_STATUS_CAUTION	= \1;
*_BBS_STATUS_ERROR	= \2;
*_BBS_STATUS_NOTICE	= \3;
*_BBS_STATUS_COOKIE	= \4;

use vars qw($VERSION); $VERSION='0.05';
sub version
{$VERSION;}

sub TRAP
{eval{$_[0]->main::TRAP()};}
sub INITIALIZE
{eval{$_[0]->main::INITIALIZE()};}

sub new
{my $e=shift; return if ref $e; my $s=bless {}, $e; $s->initialize_attribute(\@_); $s;}
sub initialize_attribute
{require Initialize; shift->Initialize::attribute(@_);}
sub initialize_path
{require Initialize; $_[0]->Initialize::path();}
sub initialize_setting
{require Setting; $_[0]->Setting::read( $_[0]->path('bbs').$_[0]->file('setting'), 'setting' );}
sub initialize_conf
{require Setting; $_[0]->Setting::read( $_[0]->path('bbs').$_[0]->file('conf'), 'conf' );}

sub operation
{
	# 適当にクエリー分解
	$_[0]->parse_query();
	# パスを生成
	$_[0]->initialize_path();
	# SETTING.TXTを読み込む
	$_[0]->initialize_setting();
	# conf.txtを読み込む
	$_[0]->initialize_conf() if -e $_[0]->path('bbs').$_[0]->file('conf');
	# 対かちゅーしゃ
	$_[0]->{'from'}->{'message'} = $_[0]->{'from'}->{'MESSAGE'},	delete $_[0]->{'from'}->{'MESSAGE'}	if $_[0]->from('MESSAGE');
	$_[0]->{'from'}->{'name'} = $_[0]->{'from'}->{'FROM'},		delete $_[0]->{'from'}->{'FROM'}	if $_[0]->from('FROM');
	# クッキーセット
	$_[0]->set_cookie();

	# モジュール呼び出し側でなんかさらに初期化したいかもしれないので
	$_[0]->INITIALIZE();

	# 新規スレ立てかレスか調べる
	if( ( $_[0]->from('bbs') && defined $_[0]->from('subject') && !defined $_[0]->from('key') ) || $_[0]->from('new') ) {
		$_[0]->flag('make_dat' => 1, 'write_dat' => 0);
	}
	elsif( ( $_[0]->from('bbs') && !defined $_[0]->from('subject') && defined $_[0]->from('key') ) && !$_[0]->from('new') ) {
		$_[0]->flag('make_dat' => 0, 'write_dat' => 1);
	}
	else {
		$_[0]->error('えらー','ありえないエラーです。','掲示板管理者かスクリプト作者に報告してもらえるとうれしいかも。',$_BBS_STATUS_ERROR);
		return;
	}
	# imodeであるか調べる
	$_[0]->flag('ua_imode'=>1) if $_[0]->from('submit') eq 'かきこむ' && $ENV{'HTTP_USER_AGENT'} !~ /Mozilla|Monazilla/;

	# 新規スレ立てならばテンプレートを表示して終了
	return if $_[0]->from('new');
	# クッキーが無い場合クッキー確認へ飛ばす
	$_[0]->error('えらー','クッキーが無いか、賞味期限切れでした。','と、いう訳で新鮮なクッキーを発行しました。そのままF5・更新ボタンでリロードを行い書き込むか、戻ってもう一度書き込んでみてください。',$_BBS_STATUS_COOKIE), return if ($_[0]->flag('ua_imode') != 1 && $ENV{'HTTP_COOKIE'} eq '' && ! $_[0]->from('code') );

	# レス書き込み確認
	$_[0]->flag('error'=>$_BBS_STATUS_NOTICE), return if $_[0]->setting('RES_CHECK') && $_[0]->flag('write_dat') && ! $_[0]->from('code');
	# スレ立て最終確認のテンプレートを表示して終了
	$_[0]->flag('error'=>$_BBS_STATUS_NOTICE), return if $_[0]->flag('make_dat') && ! $_[0]->from('code') && $_[0]->from('subject') && ! $_[0]->from('key') && $_[0]->from('time');

	# NGワード置換
	$_[0]->replace_ng_word();
	# fusianasan置換
	$_[0]->replace_fusianasan();
	# トリップ置換
	$_[0]->replace_trip();
	# キャップ置換
	$_[0]->replace_cap();
	# 名無しで投稿され、かつ、強制名前入力に設定されていない時は名無しさん設定
	$_[0]->from('name'=>$_[0]->setting('NANASHI_NAME')) if length $_[0]->from('name') == 0 && !$_[0]->setting('NAME_CHECK');

	# まとめてエラーチェック check_fromがリファレンス以外を返したらreturnで終了
	return unless $_[0]->check_from();

	# レスアンカー置換
	$_[0]->replace_resanchor(\$_[0]->{'from'}->{'message'}) if $_[0]->conf('replace_resanchor');
	# 時間を今の時間に再設定
	my $old_time = 	$_[0]->from('time');
	$_[0]->from('time'=>time);
	# 時間の設定
	$_[0]->from('date'=>$_[0]->get_datetime());
	# IDを日付の後ろに付ける
	$_[0]->set_id();

	# 罠
	$_[0]->TRAP();

	# スレ立てかレスか判断
	if( $_[0]->flag('make_dat') ) {
		return unless $_[0]->make_dat();
		$_[0]->write_log_thread() unless $_[0]->flag('cap');
	}
	elsif( $_[0]->flag('write_dat') ) {
		return unless $_[0]->write_dat();
		$_[0]->from('time'=>$old_time); # ログに書き込む時間が新しいとまずいので古い時間に戻す
		$_[0]->write_log_response() unless $_[0]->flag('cap');
	}
	else {
		$_[0]->error('えらー','ありえないエラーです。','掲示板管理者かスクリプト作者に報告してもらえるとうれしいかも。',$_BBS_STATUS_ERROR);
		return;
	}

	# HOST_CHECK(旧スクリプトBBS_SLIP相当らしい)に何か値があれば全ての発言のログを取る
	$_[0]->write_log_gonta() if $_[0]->setting('HOST_CHECK') && ! $_[0]->flag('gonta');

	# cautionフラグが立っている(注意が発動)場合はログ取る
	$_[0]->write_log_caution() if $_[0]->flag('caution');
	# banフラグが立っている(アク禁が発動)場合はログ取ってアクセス禁止にする
	$_[0]->write_log_ban() if $_[0]->flag('ban');

	# subject.txtを書き換え
	$_[0]->remake_subject();
	# subback.htmlを書き換え
	$_[0]->remake_subback();
	# index書き換え
	$_[0]->remake_index();
	# imode index書き換え
	$_[0]->remake_index_i();
	# rss書き換え
	$_[0]->remake_rss();

	# 各種ファイル圧縮
	#$_[0]->make_gz( $_[0]->path('bbs').$_[0]->file('subject') );
	#$_[0]->make_gz( $_[0]->path('bbs').$_[0]->file('subback') );
	#$_[0]->make_gz( $_[0]->path('bbs').$_[0]->file('index') );

	# パーミッション変更
	#$_[0]->set_permission();
	$_[0];
}
sub select_template # 引数：operation()の戻り値, [errorのフラグ] 戻り値：テンプレートのファイル名
{
	my $r = $_[1];
	my $f = $_[2] || $_[0]->flag('error');# 0:エラーなし 1:注意 2:致命的なエラー 3:書き込み確認 4:cookie確認

	if ( $r ) {#書き込みが終了した
		#書き込み成功
		if    ( $f == $_BBS_STATUS_NOERROR )	{ return $_[0]->template('wait'); }
		#連投注意
		elsif ( $f == $_BBS_STATUS_CAUTION )	{ return $_[0]->template('caution'); }
	} else {#書き込みが完了していない
		#cookie確認
		if    ( $f == $_BBS_STATUS_COOKIE )	{ return $_[0]->template('cookie'); }
		#アク禁直前の書き込み確認
		elsif ( $f == $_BBS_STATUS_NOTICE && $_[0]->setting('RES_CHECK') && $_[0]->flag('write_dat') )	{ return $_[0]->template('notice_write_dat'); }
		#スレ立ての書き込み確認
		elsif ( $f == $_BBS_STATUS_NOTICE && ! $_[0]->from('code') && $_[0]->from('subject') )		{ return $_[0]->template('notice_make_dat'); }
		#ただの書き込み確認
		elsif ( $f == $_BBS_STATUS_NOTICE )	{ return $_[0]->template('notice_write_dat'); }
		#致命的なエラー
		elsif ( $f == $_BBS_STATUS_ERROR )	{ return $_[0]->template('error'); }
		#スレ立てフォーム表示
		elsif ( $_[0]->from('new') )		{ return $_[0]->template('make_dat'); }
	}
	return $_[0]->template('error');
}

sub make_dat
{require Dat; $_[0]->Dat::make();}
sub write_dat
{require Dat; $_[0]->Dat::write();}
sub write_log_thread
{require Log; $_[0]->Log::write( $_[0]->path('bbs').$_[0]->file('thread'), $_[0]->setting('THREAD_TATESUGI'), $_[0]->Log::read( $_[0]->path('bbs').$_[0]->file('thread'), 'thread' ), $_[0]->Log::format() );}
sub write_log_response
{require Log; $_[0]->Log::write( $_[0]->path('bbs').$_[0]->file('response'), $_[0]->setting('RES_RENZOKU'), $_[0]->Log::read( $_[0]->path('bbs').$_[0]->file('response'), 'response' ), $_[0]->Log::format() );}
sub write_log_caution
{require Log; $_[0]->Log::write( $_[0]->path('bbs').$_[0]->file('caution'), $_[0]->setting('PING_ITAZURA'), $_[0]->Log::read( $_[0]->path('bbs').$_[0]->file('caution'), 'caution' ), $_[0]->Log::format() );}
sub write_log_ban
{require Log; $_[0]->Log::write( $_[0]->path('bbs').$_[0]->file('ban'), undef, $_[0]->Log::read( $_[0]->path('bbs').$_[0]->file('ban'), 'ban' ), $_[0]->Log::format() );}
sub write_log_gonta
{$_[0]->file( 'gonta' => $_[0]->from('bbs').'.cgi' );my $bbs = $_[0]->from('bbs');my $key = $_[0]->from('key');my $message = $_[0]->from('message');my $subject = $_[0]->from('subject');require Log;$_[0]->Log::write($_[0]->path('gonta').$_[0]->file('gonta'), undef, undef, join($_[0]->conf('delimiter'), $_[0]->from('name'), $_[0]->from('mail'), $_[0]->get_datetime().'<strong>'.$_[0]->get_host().'</strong>', "<span style=\"color:#F00;font-size:1.5em;\">$subject</span><ul>$message</ul><a href=\"../test/read.cgi/$bbs/$key\">$bbs</a>", $bbs) );}

sub remake_subject
{require Subject; my $subject = $_[0]->Subject::read(); if ( $_[0]->flag('make_dat') ) { $_[0]->Subject::add_thread( $subject ); } elsif( $_[0]->flag('write_dat') ) { $_[0]->Subject::move_thread( $subject ); } $_[0]->Subject::remake( $subject ); $_[0];}
sub remake_subback
{require Subback; my $subject = $_[0]->list('subject'); unless($subject){ require Subject; $subject = $_[0]->Subject::read(); } $_[0]->Subback::remake( $subject ); $_[0];}
sub remake_index
{$_[0]->_remake_file($_[0]->path('bbs').$_[0]->file('index'), $_[0]->expand_template($_[0]->path('template').$_[0]->template('index'))); $_[0];}
sub remake_index_i
{$_[0]->_remake_file($_[0]->path('imode').$_[0]->file('index_i'), $_[0]->expand_template($_[0]->path('template').$_[0]->template('index_i'))); $_[0];}
sub remake_rss
{$_[0]->_remake_file($_[0]->path('rss').$_[0]->file('rss'), $_[0]->expand_template($_[0]->path('template').$_[0]->template('rss'))); $_[0];}
sub _remake_file # _remake_file( 上書きで書き出すファイル名, 書き出すデータのリファレンス );
{
	return unless defined $_[2];
	return unless open FH, ">$_[1]";
	flock FH, 2;
	seek FH, 0, 0;
	print FH ${$_[2]};
	truncate FH, tell FH;
	close FH;
	$_[0];
}

sub make_gz
{require Compression; $_[0]->Compression::write($_[1]);}
sub expand_template
{require Template; my $data = $_[0]->Template::read( $_[1] ); $_[0]->Template::expand( $data );}

sub _accessor #アクセサ
{
	my $n = (caller 1)[3]; #とりあえず、アクセサを呼び出した呼び出し元のサブルーチン名を持ってくる
	$n =~ s/^.*:://; #とりあえず、パッケージ名はいらないから消す
	return each %{$_[0]->{$n}} unless exists ${$_[1]}[0]; #引数なしで呼ばれたら、とりあえずそのハッシュが保持してるキー一覧を返す
	return $_[0]->{$n}->{${$_[1]}[0]} unless exists ${$_[1]}[1]; #引数が1つだけで呼ばれたら、とりあえずその引数をキーとみなしてハッシュから読み込んで返す
	my %a = @{$_[1]}; my $k; #引数が２つ以上で呼ばれたら、とりあえず値の設定であるとみなしキーと値をハッシュへ登録
	$_[0]->{$n}->{$k} = $a{$k} while $k = each %a;
	$_[0];
}
sub from
{shift->_accessor(\@_);}
sub list
{shift->_accessor(\@_);}
sub path
{shift->_accessor(\@_);}
sub setting
{shift->_accessor(\@_);}
sub conf
{shift->_accessor(\@_);}
sub file
{shift->_accessor(\@_);}
sub template
{shift->_accessor(\@_);}
sub flag
{shift->_accessor(\@_);}
sub counter
{shift->_accessor(\@_);}
sub headerfields
{shift->_accessor(\@_);}
sub cookie
{shift->_accessor(\@_);}
sub permission
{shift->_accessor(\@_);}
sub error
{$_[0]->{'error_reason'}->{'title'}=$_[1]; $_[0]->{'error_reason'}->{'head'}=$_[2]; $_[0]->{'error_reason'}->{'body'}=$_[3]; $_[0]->flag('error'=>$_[4]); $_[0];}

sub decode_query #これはその内消す
{$_[0]->parse_query();}
sub parse_query #クエリーを分解・デコードしてfromにいれる
{
	my ($s, $buf, $i, $n, $v, $br, %unescape_cache, @data);
	$s = shift;
	$i = 0;
	$br = $s->conf('line_break');

	$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
	if ( $ENV{'REQUEST_METHOD'} eq 'GET' ) {
		$buf = $ENV{'QUERY_STRING'};
	} elsif ( $ENV{'REQUEST_METHOD'} eq 'POST' ) {
		read STDIN, $buf, $ENV{'CONTENT_LENGTH'};
	} else {
		return;
	}
	@data = split '&', $buf;
	while($_=$data[$i++]) {
		($n,$v) = split '=', $_, 2;
		$s->from( $n => '' ), next if length $v == 0;
		$v =~ tr/+/ /;
		$v =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/$unescape_cache{$1} ||= chr hex $1/eg;
		$s->replace_char_entity_set(\$v) if $s->conf('replace_msg_char_entity_set');
		unless ($n eq 'message' || $n eq 'MESSAGE') {
			$v =~ s/\x0D\x0A|\x0D|\x0A|[\x00-\x1F]//g;
		} else {
			$s->replace_unicode(\$v) unless $s->setting('UNICODE_CHANGE') eq 'checked';
			$s->replace_line_break(\$v);
		}
		$s->from( $n => $v );
	}
	$s;
}
sub parse_multipart_formdata # 作りかけ
{
  $_[0];
}
sub print_headerfields
{return $_[0] if $_[0]->flag('print_headerfields') != 0; my ($n,$v); print STDOUT "$n$v\n" while ($n,$v) = $_[0]->headerfields(); print STDOUT "\n"; $_[0]->flag('print_headerfields' => 1); $_[0]; }

sub check_from
{require Check; $_[0]->Check::from();}
sub check_log_thread
{require Check; $_[0]->Check::log_thread();}
sub check_log_response
{require Check; $_[0]->Check::log_response();}
sub check_log_caution
{require Check; $_[0]->Check::log_caution();}
sub check_log_ban
{require Check; $_[0]->Check::log_ban();}
sub check_log_proxy
{require Check; $_[0]->Check::proxy_list();}

sub replace_line_break
{require Replace; $_[0]->Replace::line_break($_[1]);}
sub replace_tag
{require Replace; $_[0]->Replace::tag($_[1]);}
sub replace_char_entity_set
{require Replace; $_[0]->Replace::char_entity_set($_[1]);}
sub replace_unicode
{require Replace; $_[0]->Replace::unicode($_[1]);}
sub replace_cap
{return $_[0] unless index($_[0]->from('mail'),'#') > -1; require Replace; $_[0]->Replace::cap($_[1]);}
sub replace_trip
{return $_[0] unless index($_[0]->from('name'),'#') > -1; require Replace; $_[0]->Replace::trip($_[1]);}
sub replace_fusianasan
{require Replace; $_[0]->Replace::fusianasan($_[1]);}
sub replace_resanchor
{require Replace; $_[0]->Replace::res_anchor($_[1]);}
sub replace_urianchor
{require Replace; $_[0]->Replace::uri_anchor($_[1]);}
sub replace_ng_word
{require Replace; $_[0]->Replace::ng_word($_[1]);}

sub set_cookie
{require Set; $_[0]->Set::cookie();}
sub set_id
{require Set; $_[0]->Set::id();}
sub set_permission
{require Set; $_[0]->Set::permission();}

sub get_datetime
{require Get; $_[0]->Get::datetime();}
sub get_id
{require Get; $_[0]->Get::id();}
sub get_cap
{return unless exists $_[1]; require Get; $_[0]->Get::cap($_[1]);}
sub get_trip
{return unless exists $_[1]; require Get; $_[0]->Get::trip($_[1]);}
sub get_host
{require Get; $_[0]->Get::host();}
sub get_spid
{require Get; $_[0]->Get::spid();}

sub DESTROY
{}
sub END
{}
1;
__END__