List of bbs-ex2/bbs.cgi

Fri Mar 29 16:04:19 2024

戻る

TEXTAREA で表示(カット&ペーストむき)

#!/usr/local/bin/perl
# ---------------------------------------------------------------------
#
# bbs.cgi
#
# 1998/01/23 Ver.0.05 
# 1998/01/23 Ver.0.06	bugfix
# 1998/01/26 Ver.0.07 
#		タイトルにハンドル名を付加	ID 欄には E-mail addr の名前部分を
# 1998/01/30 Ver.0.08	
#		書き込むとモードが初期値になる。bugfix
#		webmaster へのメール
#		カスタマイズ可能な設定値を外部化し bbs.env としました。
# 1998/01/30 Ver.0.10
#		未読ポインターの付加&モードの保存
#		Re: への対応  第1弾
# 1998/01/30 Ver.0.14	bugfix
# 1998/01/31 Ver.0.15 
#		新しいメッセージがないときに n メッセージ表示のボタンを追加
#		偽 pc-van のため w コマンドを追加。こんなの使わないよなぁ(^^;;;
# 1998/02/03 Ver.0.16
#		排他ロック設定忘れ(^^;;;								bugfix
#		メッセージ#のカウントアップ 							bugfix	
# 1998/02/06 Ver.0.17 
#		内容の中の http アドレスへもリンクをつける。
#		URL のチェックしていますが、チェックしないほうがよいかもしれませんね(^^;;;
#		引用マークのカスタマイズを可能にしました。
# 1998/02/16 Ver.0.18 
#		bugfix 内容の中の http アドレスがエラーの時 TEXTAREA に TAG が入る。
#		chkurl の名称変更に対応
# 1998/03/02 Ver.0.19 
#		日本語コード変換へ対応
#		email の入力が省略できるように設定できませんでした。	bugfix
#		webmaster へのメールの < 等の除去忘れも発見。		bugfix
#		res での tag 除去忘れも発見。							bugfix
#		mail address の 形式チェックの @ より前の . を考慮。	bugfix
#		http アドレス判定の文字列を見直し						bugfix
# 1998/03/03 Ver.0.20	エラーの時 タイトル に TAG が入る。 	bugfix
# 1998/03/25 Ver.0.21
#		jcodeg.pl の改変部を getcode.pl とし jcode.pl のオリジナルと併用する
#		cookie の設定が動作していませんでした。 				bugfix 
# 1998/03/25 Ver.0.21j0 日本語コード変換の為の試作版
# 1998/03/28 Ver.0.22
# 1998/04/06 Ver.0.23
#		日本語コードの判定 ブラウザの Win Mac の判定忘れ(^^;;;	bugfix
# 1998/04/07 Ver.0.24	chkurl のパッケージ化
# 1998/04/08 Ver.0.25	mail の送信先を複数指定できるように拡張しました。
# 1998/05/08 Ver.0.32
#		タイトルと名前の中の改行を削除							bugfix
#		POST method を使わない設定を可能にしました。for luke
# 1998/05/13 Ver.0.33
#		バッファリングを停止し高速化を狙ってみました。
#		mail への subject でボード名を [] で囲うようにしました。
#		日本語コードの判定で [ja-euc] の処理を変更しました。
# 1998/05/13 Ver.0.34
# 1998/05/14 Ver.0.35	cookie のタイミングを訂正				bugfix
# 1998/06/15 Ver.0.36	日本語コードの判定を変更しました。
# 1998/06/17 Ver.0.37
#		エラー時の処理の bugfix 								bugfix
#		cookie のタイミングを訂正								bugfix
#		mail への subject で NO も [] で囲うようにしました。
# 1998/08/24 Ver.0.38	アンロックの処理の bugfix				bugfix
# 1998/10/20 Ver.0.39	URL のチェックでのステータス 302 へ対応
# 1999/01/08 Ver.0.40
#		歓迎メッセージの有無を	$welcome で指定
#		cookie と未読処理の動作を見直しました
#		cookie の日付を正規化
#		$head, $tail を指定できるように拡張
#		url のチェックでのステータス 301 に対応
#		メールの送付を CC か BCC を指定できるように
# 1999/01/08 Ver.0.41	メールの発信元、送付先を整理しました。
# 1999/01/11 Ver.0.42	ボタン表示を見直しました。
# 1999/01/19 Ver.0.43	URL のチェックを $chkurl でオプション化
# 1999/01/29 Ver.0.44
#		flock の使用を $useflock でオプション化
#		メールの subject にタイトルを追加
#		cookie の有効期限を MSIE へ対応 (MSIE の方がおかしいと思う(^^;;;
# 1999/02/11 Ver.0.46
#		メールの subject にタイトルを位置調整&ニックネームを追加
#		アクセス制限域での未読ポインタファイル機能を追加準備 (BIGLOBE では使えませんが(^^;;;
#		書込み時のレスポンスのタイミングを変更
#		2重書込をエラーにする。
# 1999/02/11 Ver.0.48
# 1999/02/20 Ver.0.49
# 1999/02/24 Ver.0.50
#		Mail 中の URL を HTTP_REFERER から、そのメッセージへの Res へ変更
# 1999/02/25 Ver.0.51	Re: でタイトル先頭の Re:#> は複写しない。
# 1999/02/27 Ver.0.52	メールのサブジェクト内で encode されてしまうのを修正
# 1999/02/27 Ver.0.53	$locator を追加
# 1999/03/07 Ver.0.54
#		削除機能を追加
#		書込み用テキストエリアの大きさをカスタマイズ可能に
# 1999/03/08 Ver.0.55
# 1999/03/09 Ver.0.56
#		MSIE での書込み用テキストエリアの大きさを調整機能
#		ホスト側未読ポインタファイルへハンドル名を付加。
#		未読ポインタファイルに互換性がありません。いちど空にしてください。
# 1999/03/16 Ver.0.57
# 1999/03/17 Ver.0.58	メールの形式をシンプルに変更しました。
# 1999/03/18 Ver.0.59	bugfix
# 1999/03/23 Ver.0.60	オプション $pre, $mlist を追加
# 1999/03/24 Ver.0.61	メール配信先の include
# 1999/03/25 Ver.0.62
# 1999/03/26 Ver.0.63
# 1999/03/26 Ver.0.64	本文中の http アドレスの誤判定を調整
# 1999/03/26 Ver.0.65	to: $mlist を追加
# 1999/03/28 Ver.0.66	$border を追加
# 1999/04/16 Ver.0.68
# 1999/04/18 Ver.0.69
# 1999/04/26 Ver.0.70
# 1999/04/26 Ver.0.71	bugfix
# 1999/05/05 Ver.0.72	削除の動作を改善
# 1999/05/18 Ver.0.73	削除の範囲の bugfix 午前中に誤動作していました。
# 1999/09/01 Ver.0.74	2000 年問題への対応
# 1999/11/24 Ver.0.75	bugfix
# 1999/11/26 Ver.0.76	bugfix
# 1999/12/14 Ver.0.77	Date ヘッダーを追加し、カスタマイズ用変数 $timezone を追加
# 1999/12/19 Ver.0.78	サーチ用
# 1999/12/20 Ver.0.81
# 2000/01/06 Ver.0.82
# 2000/01/07 Ver.0.83
# 2000/01/20 Ver.0.84
# 2000/01/21 Ver.0.85	整形済モードを追加
# 2000/01/21 Ver.0.86	$body を追加
# 2000/01/26 Ver.0.87	bugfix
# 2000/01/29 Ver.0.88	書きこみ完了メッセージの処理を変更
# 2000/01/30 Ver.0.89	公開版
# 2000/03/19 Ver.0.90	当日と1日前のメッセージを削除できるよう変更
# 2000/05/11 Ver.0.91
#		Mail のヘッダーへ追加 MIME-Version,Content-Type,Content-Transfer-Encoding
# 2000/07/30 Ver.0.92
# 2000/12/10 Ver.0.93
# 2000/12/11 Ver.0.94 MSIE 対応,暫定対策
# 2000/12/13 Ver.0.95 MSIE 対応,暫定対策
# 2000/12/20 Ver.0.96 Content-Type text/html; charset=Shift_JIS を追加
# 2000/12/20 Ver.0.98
# 2001/10/23 Ver.0.99 Locate にも、charset=Shift_JIS を追加
#
$copyright		='掲示板 Ver.0.99 Copyright (C) 1998-2000 gama';
#		Copyright  (C) 1998-2000 がま <gama@mvg.biglobe.ne.jp>
#		http://www2d.biglobe.ne.jp/~gama/cgi/index.cgi
#
# ---------------------------------------------------------------------
#		メール配信モード
#			$webmaser か @mailgr が設定されている時
#
#			@mailgr 	送付先のリスト
#						'include:ファイル名'
#						を設定することにより、ファイルから読み込まれる。
#
#			$cc 		@mailgr への送信方法の指定	  To,Cc,Bcc
#
#			$webmaster が設定されている時
#						$webmaster と @mailgr へ配信される。
#
#				From:		$from で指定されたアドレス
#							$from を省略した場合は、$webmaster
#				To: 		$webmaster で指定されたアドレス
#				Reply-to:	書き込んだ人のアドレス
#
# ---------------------------------------------------------------------
#		メーリングリストモード
#
#			$mlist が設定されている場合
#
#			$webmaster, @mailgr, $from の設定は無視されます。
#
#			$pre =1 の設定を推奨しますが必須ではありません。
#
#					From:		書き込んだ人のアドレス
#					Reply-to:	$mlist で指定されたアドレス
#
#		メーリングリストとしての機能は別途有償で提供されています。
#
# ---------------------------------------------------------------------
$body		='<BODY BGCOLOR="#FFFFFF">';
$cc 		='Bcc'; 		# グループメールの指定 'Cc' or 'Bcc' or 'To'
$q_char 	='》';			# 引用マーク
$m_mode 	='p';			# 書込みの method	p: post  g: get
$u_mode 	='';			# 書込み
$delmsg 	= 1;			# 削除機能			0:なし 1:あり
$d_mode 	='';			# 削除モード
$r_mode 	='';			# 参照モード
$welcome	= 1;			# 歓迎メッセージ	0:なし 1:あり
$delmsg 	= 1;			# 削除機能			0:なし 1:あり
$chkurl 	= 1;			# url のチェック	0:なし 1:あり
$useflock	= 1;			# flock 使用		0:なし 1:あり
# ---------------------------------------------------------------------
# 検索機能は限定リリース中です。いろいろと矛盾が生じる場合があります。
$usesrch	= 0;			# 検索機能使用		0:なし 1:あり
$idxfile	= 'msgdb.dat';	# メッセージ検索用インデックス
# ---------------------------------------------------------------------
$ENV{'TZ'}	= 'JST-9';		# timezone の指定
$timezone	= '+0900 (JST)';# メールのヘッダー用のタイムゾーン
$debug		= 0;			# debug 用フラグ
# ---------------------------------------------------------------------
$usepfile	= 0;			# 未読ポインタファイル使用	  0:なし 1:あり
# 注意!
# $usepfile は個別の UserID でアクセス制限されている場合だけ使用できる。
# BIGLOBE では使用できない。
# また @guests にホスト側で管理しない ID を列挙できる。
# ---------------------------------------------------------------------
$form_rows	= 20;			# 書込み用テキストエリア 行数
$form_cols	= 80;			# 書込み用テキストエリア 桁数
# ---------------------------------------------------------------------
require 'bbs.env';						# 環境設定、カスタマイズ用
require 'getcode.pl';					# 改造版 getcode
require 'jcode.pl'; 					# jcode
require 'chkurl.pl' 	if $chkurl; 	# chkurl
require 'k2k.pl'		if $usesrch;	# k2k
# ---------------------------------------------------------------------
$file			="$msgdir/$filehead";
# ---------------------------------------------------------------------
$LOCK_SH = 1;			# 共有ロック
$LOCK_EX = 2;			# 排他的にロック
$LOCK_NB = 4;			# ブロックしない
# ---------------------------------------------------------------------
{
	# MSIE は、# 書込み用テキストエリア 桁数 を調整 ------------------
	if ( $ENV{'HTTP_USER_AGENT'} =~ /^Mozilla.*compatible; MSIE / ) {
		$form_cols	= int($form_cols *1);
	}
	$|=1;
	# YY/MM/DD hh:mm ------------------------------------------------------
	my($sec,$min,$hour,$mday,$mon,$year,$wday)=localtime;
	$time = sprintf("%2.2d\/%2.2d\/%2.2d  %2.2d:%2.2d",
						$year%100,$mon+1,$mday,$hour,$min );
	# mail ヘッダー内の Date-----------------------------------------------
	#	10 Aug 2000 12:34:56 +GMT	   ;RFC1123 など
	#	Wdy, 10-Aug-2000 12:34:56 GMT  ;RFC822 では Wdy は省略可なのだが...
	#		Date: Tue, 16 Nov 1999 06:34:15 +0900 (JST) :NN4.5 での例	 
	#
	$mail_date =sprintf("Date: %s, %2.2d %s %4.4d %2.2d:%2.2d:%2.2d %s",
						&getweek($wday),$mday,&getmonth($mon),$year+1900,
						$hour,$min,$sec,$timezone);
	# ---------------------------------------------------------------------
	if ( $ENV{'CONTENT_TYPE'} eq "application/x-www-form-urlencoded")  {
		read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
	} else {
		$in=$ENV{'QUERY_STRING'};
	}
	($cmd,undef) = split('&',$in);
	if ($cmd =~ /=/ ){
		my(@pairs) = split('&', $in);	# 
		foreach $pair (@pairs) {
			my($name, $value) = split('=', $pair);
			unless ($FORM{$name}) {
				$FORM{$name} = &str_decode_from_form($value);
			} else {
				$FORM{$name} = $FORM{$name}.','.&str_decode_from_form($value);
			}
		}
		$cmd		= $FORM{'cmd'};
		$name		= $FORM{'Name'};
		$email		= $FORM{'E_mail'};
		$hp 		= $FORM{'HomePage'};
		$title		= $FORM{'Title'};
		$comment	= $FORM{'Comment'};
		$pre_mode	= $FORM{'pre_mode'};
		$ml_header	= $FORM{'ml_header'};
		$keyword	= $FORM{'Keyword'};
	}
	# ---------------------------------------------------------------------
	&set_mode;
	# ---------------------------------------------------------------------
	&get_lastno;				 # 発言 # のカウント
	# -----------------------------------------------------------------------
	if ($u_mode) {
		&write_bbs;
	} elsif ($s_mode and $usesrch) {
		&get_cookie;					# cookie 
		&srch_msg;
	} elsif ($cmd =~ /i/ and $usesrch) {
		&gen_idx;
	} elsif ($d_mode eq 'z' ) {
		&get_cookie;					# cookie 
		&delete_msg;
	} else {
		&get_cookie;					# cookie 
		&read_bbs;
	}
	exit;
}
# mode の設定 --------------------------------------------------------
#	t タイトル表示
#	m 内容表示
#	f 発言順
#	b 逆順
#	r レスポンスの書込み
#	n 未読処理
#	w 書込み FORM のみ
#	x 書込み完了メッセージ
#	u FORM からの書込み
#	d 削除モード
#	c 削除確認!
#	z 削除!
#	s 検索
#	i 検索用インデックス作成
sub set_mode {
	$no  =	$cmd;
	$no  =~ s/[a-z]*//;

	if		( $cmd =~ /([dcz])/ ) { # 削除
		$d_mode = $1;
	}
	if		( $cmd =~ /([tm])/ ) {
		$r_mode = $1;
	} elsif ( $c_r_mode ) {
		$r_mode = $c_r_mode;
	}
	if		( $cmd =~ /([fb])/ ) {
		$o_mode = $1;
	} elsif ( $c_o_mode ) {
		$o_mode = $c_o_mode;
	}
	if		( $cmd =~ /r/ ) {		# Responce to $no
		$r_no	= $no;
	}
	if		( $cmd =~ /u/ ) {
		$u_mode  = 'u';
		$cmd  =~ s/u//;
	}
	if		( $cmd =~ /s/ ) {
		$s_mode    = $FORM{'srchmode'};
	}
	if		( $no eq '' && $cmd eq '' ) {
		$cmd	= $cmd . "n";		# 未読処理モードを追加
	}
	if		( $c_point < 1 ) {
		$c_point = 1;
	}
	# -----------------------------------------------------------------------
	if	($r_mode eq 'm' ) { 					 # m 内容表示
		$per_scr = $m_per_scr;					# msg 表示数
	} else {
		$per_scr = $t_per_scr;					# タイトル表示数
	}
	# -----------------------------------------------------------------------
	&set_pre;
}
# ---------------------------------------------------------------------------
sub set_pre {
	if		($pre_mode eq 'off') {
		undef $pre;
		undef $spre;
	} elsif ( ($pre_mode eq 'on') or $pre or $ml_header) {
		$pre		='<PRE>';
		$spre		='</PRE>';
		$pre_mode = 'on';
	} else {
		$pre_mode = 'off';
	}
}
# ---------------------------------------------------------------------------
sub get_lastno {
	# 発言 # のカウント -----------------------------------------------------
	open(FCTR,"<$fctr");
	flock(FCTR,$LOCK_SH)	if $useflock;		# 共有ロック
	$last_no=<FCTR>;
	close(FCTR);
	chomp($last_no);
}
# 削除 ---------------------------------------------------------------
sub delete_msg {
	unless ($delmsg) {
		&err_html("削除できません。(delmsg disable)");
		exit;
	}
	unless (open(MSG, "+<$file$no")) {		# open
		&err_html("指定されたメッセージを読めません。($file$no.)");
		exit;
	}
	flock(MSG,$LOCK_EX)    if $useflock;	# 排他ロック
	my(@temp)=<MSG>;
	if (&not_author($temp[1])) {
		&err_html("削除できません。(not author)");
		exit;
	}
	seek(MSG, 0, 0);
	print(MSG "<!-- delete at $time by $ENV{'REMOTE_USER'}:$name <$email>");
	print MSG @temp;
	print(MSG " -->\n");
	close(MSG);

	my($nextcmd)= "$o_mode$r_mode" .'n';		  #ex9
	print "Content-type: text/html\n\n";
	print <<END;
		<HTML><HEAD><TITLE>削除されました</TITLE></HEAD>
		$body
		<H2>削除されました</H2>
		<HR><BLOCKQUOTE>
@temp
		<CENTER>
		<FORM METHOD="GET" ACTION="$cgi_name">
		<INPUT TYPE="hidden" NAME="cmd" VALUE="$nextcmd">
		<INPUT TYPE="submit" VALUE="戻る"></FORM>
		</CENTER>
		</BLOCKQUOTE><HR>
		</BODY></HTML>
END
	# MAIL -----------------------------------------------------------------
	&send_mail($no, '発言者削除', '', '');
}
# 削除権限のチェック ------------------------------------------------------
sub not_author{
	#★タイトル の行から E-Mail, 日付を取出す
	my($tit) = $_[0];
	$tit =~ /.*<A HREF=\"mailto:(.*?)\".*(\d\d\/\d\d\/\d\d).*/;
	my($msg_email) =$1;
	my($msg_date)  =$2; 				# YY/MM/DD
	unless ($msg_email eq $email) { 	# e-mail addr の一致を確認
		return 1;		# not author
	}
	# ----------------------------------------------------------------------
	# 昨日に設定
	my($sec,$min,$hour,$mday,$mon,$year)=localtime(time);
	my($date0)	= sprintf("%2.2d\/%2.2d\/%2.2d", $year%100,$mon+1,$mday);
	($sec,$min,$hour,$mday,$mon,$year)	=localtime(time-60*60*24);
	my($date1)	= sprintf("%2.2d\/%2.2d\/%2.2d", $year%100,$mon+1,$mday);

	# 日付が一致したとき
	if ( $date0 eq $msg_date ) {
		return 0;						# OK
	}
	# 日付が1日前のとき
	if ( $date1 eq $msg_date ) {
		return 0;						# OK
	}
	return 1;							# NG 削除期限を超過
}
# 書込 --------------------------------------------------------------------
sub write_bbs {
	# jcode -------------------------------------------------------
	local($jstr)=join(' ', $title, $name, $comment);
	local($match, $icode) = &getcode'getcode(*jstr);
	unless ($icode) {
		if ( $ENV{'HTTP_USER_AGENT'}=~ /Mac|Win/) {
			$icode = 'sjis';
		} else {
			$icode = 'euc';
		}
	}
	if ($icode ne 'sjis') {
		&jcode'convert(*title, 'sjis', $icode );
		&jcode'convert(*name, 'sjis', $icode );
		&jcode'convert(*comment, 'sjis', $icode );
	}
	# -------------------------------------------------------------
	$name		= &str_conv_for_html($name);
	$title		= &str_conv_for_html($title);
	$comment	= &str_conv_for_html($comment);
	chomp($name);
	chomp($title);
	# -------------------------------------------------------------
	unless ($name) {				# Nickname がないとき Error
		&err_html("ニックネームが入力されていません。");
		exit;
	}
	if ($email eq $dflt_email) {	# email addr 記入なし
		$email	= "";
	}
	if ($need_email ) {
		unless ($email) {			# email addr がないとき Error
			&err_html("E-Mail アドレスが入力されていません。");
			exit;
		}
		unless ($email =~ /^[\w\-\_\.]+@[\w\-\_]+(\.[\w\-\_]+)+$/ ) {
			&err_html("E-Mail アドレスの形式がエラーになりました。");
			exit;
		}
	}
	if ( $hp eq $dflt_hp ) {		# Homepage	URL 記入なし
		$hp 	= '';
	}
	if ( $hp ne '' ) {				# HomePage の URL のチェック
		my($err)  = &check_url($hp);
		if ($err) {
			&err_html("入力されたアドレスへアクセスできませんでした。<BR>"
			."$hp<BR>$err<BR>");
			exit;
		}
	}
	unless ( $title ) { 			# title がないときは Error を表示
		&err_html("タイトルが入力されていません。\n");
		exit;
	}
	$title	=~ s/#(\d+)/<A HREF=\"${cgi_name}?cmd=${o_mode}${r_mode}$1\">#$1<\/A>/;

	# 本文内の http アドレス -----------------------------------------------
	$comment=~ s/(http:\/\/\S+?)(\s| |$)/<A HREF=\"$1\">$1<\/A>$2/g;	# 空白文字以外
	my($temp)	= $comment;
	while ( $temp=~ /(<A HREF=\".+?\">)(.*)/ ) {
		my($url) = $1;				# マッチした文字列
		$temp=$2;					# マッチしたのより後ろ
		$url =~ s/.*<A HREF=\"(.+?)\">.*/$1/;
		my($err) = &check_url($url);
		if ($err) {
			&err_html( "本文中に記述されたアドレスへアクセスできませんでした。<BR>"
				."$url<BR>$err<BR>" );
			exit;
		}
	}
	# 発言 # のカウント ----------------------------------------------------
	unless (open(FCTR,"+<$fctr")) {
			&err_html( "内部エラー<BR>"
					  ."$fctr が open できません。(設置の状態を確認してください)");
			exit;
	}
	flock(FCTR,$LOCK_EX)	if $useflock;			# 排他ロック
	my($old_no)=<FCTR>;
	chomp($old_no);
	# 新メッセージのタイトルと内容 -----------------------------------------
	$tit_name .= $title.' '.$name;
	$msghead   = "$tit_name<BR>\n"
				."★内容<BR>\n$pre";
	$msgbody   = "$comment\n";
	unless ($pre) {
		$msgbody  =~ s/\n/<BR>\n/g; 				# 改行を <BR> へ
	} else {
		$msgbody .= "$spre\n";
	}
	if ($hp) {
		$msgbody .=  sprintf("<A HREF=\"%s\">%s</A><BR>\n", $hp, $hp);
	}
	$msgbody	 .= "<HR WIDTH=90%>\n";
	if ($locator) { 								# $locator の処理
		$msgbody  =~ s/(<A HREF=\")http/$1$locator/g;
	}
	# 2重書込のチェック ---------------------------------------------------
	if ( open(OLDMSG,"$file$old_no") ) {
		flock(OLDMSG,$LOCK_SH)	  if $useflock; 	# 共有ロック
		<OLDMSG>;									# 2行分読み飛ばし
		<OLDMSG>;
		my($oldmsg);
		while (<OLDMSG>) {
			$oldmsg .=$_;
		}
		if ($oldmsg eq $msghead.$msgbody) {
			&err_html( "このメッセージは書込済です。");
			exit;
		}
		close OLDMSG;
	}
	# 発言 # のカウントアップ ----------------------------------------------
	my($new_no) = $old_no + 1;
	seek(FCTR, 0, 0);
	printf(FCTR "%d", $new_no);
	# COOKIE----------------------------------------------------------------
	&set_cookie_name;
	# ----------------------------------------------------------------------
	my($t_name) = $name;
	if ( $email ne '' ) {
		$t_name 	=  $email;
		$t_name 	=~ s/^([\w\-\_\.]+)@[\w\-\_\.]+$/$1/;
		$t_name 	=  "<A HREF=\"mailto:$email\">$t_name</A>";
	}
	$bbsmsg   =  sprintf("#%s %s<BR>\n", $new_no,$bbsname)
				.sprintf("★タイトル (%s) %s<BR>\n",$t_name,$time)
				.$msghead
				.$msgbody;
	# BBS ------------------------------------------------------------------
	unless (open(BBS,">$file$new_no")) {
		&err_html("Can't open $file$new_no.<BR>"
				 ."ディレクトリ($msgdir/)とパーミッション(777)を確認してください。");
		exit;
	}
	flock(BBS,$LOCK_EX) 	if $useflock;			 # 排他ロック
	print(BBS $bbsmsg); 			# ここで書き込み!
	close(FCTR);
	close(BBS);
	# 古いメッセージを削除 -------------------------------------------------
	$delno=$new_no - $msg_max;
	unlink("$file$delno");			# 古いメッセージを一つ削除
	$delno=$delno - 1;
	unlink("$file$delno");			# 念のため古いメッセージをもう一回削除
	# MAIL -----------------------------------------------------------------
	&send_mail($new_no, $title, $name, $msgbody);
	# Location -------------------------------------------------------------
	my($nextcmd)= "$o_mode$r_mode" .'nx';
	print "Location: ${cgi_name}?cmd=$nextcmd\n\n";
#	print "Location: ${cgi_name}?cmd=$nextcmd; charset=Shift_JIS\n\n";
}
# --------------------------------------------------------------------------
sub send_mail {
	my($no) 	= $_[0];
	my($subj)	= &str_detag($_[1]);	 # tag を除去
	my($name)	= &str_detag($_[2]);	 # tag を除去
	my($msg)	= &str_detag($_[3]);	 # tag を除去
	# MAIL -----------------------------------------------------------------
	if ( $mlist or $webmaster or @mailgr) {
		$msg	=~ s/^#/\$/;			 # pcvan の log への配慮
		unless (open(MAIL, "| $nkf -S | $sendmail -t")) {
			&err_html("内部エラー<BR>"
					 ."sendmail が open できません。(設置の状態を確認してください)");
			exit;
		}
		if ($mlist) {
			print(MAIL		"From: \"$name\" <$email>\r\n");
			print(MAIL		"To: $mlist\r\n");
			print(MAIL		"Reply-To: $mlist\r\n");
		} else {
			if ($from) {
				print(MAIL	"From: $from\r\n");
			} else {
				print(MAIL	"From: $webmaster\r\n");
			}
			print(MAIL		"To: $webmaster\r\n");
			if ($email) {
				print(MAIL	"Reply-To: \"$name\" <$email>\r\n");
			}
			$subj .= ' '.$name;
			foreach $member (@mailgr) {
				if ($member =~ /^include:(.*)/i) {
					open(MAILGR,"$1");
					flock(MAILGR,$LOCK_SH)	   if $useflock;			# 共有ロック
					while (<MAILGR>) {
						chomp;
						print(MAIL	"$cc: $_\r\n");
					}
					close(MAILGR);
				} else {
					print(MAIL	"$cc: $member\r\n");
				}
			}
		}
		print(MAIL		$mail_date,"\r\n");
		print(MAIL		"MIME-Version: 1.0\r\n");
		print(MAIL		"Content-Type: text/plain; charset=ISO-2022-JP\r\n");
		print(MAIL		"Content-Transfer-Encoding: 7bit\r\n");
		print(MAIL		"Subject: [$bbsname $no] $subj\r\n","\r\n");
		unless ($d_mode eq 'z') {
			print(MAIL $msg );
			print(MAIL "\n\n");
			print(MAIL 'Re:#', $no, ' http://'
					  , $ENV{'SERVER_NAME'}, $ENV{'SCRIPT_NAME'},
					  , '?cmd=mr', $no );
		}
		close(MAIL);
	}
}
# 検索用 インデックスの作成------------------------------------------------------
sub gen_idx {
	$idxwk	=$idxfile.'.tmp';
	unless (open(IDXWK,"+<$idxwk") or open(IDXWK,">$idxwk")) {
		&err_html("作業用ファイルが開けませんでした。($idxwk)");
		exit;
	}
	if ($useflock) {
		unless (flock(IDXWK, $LOCK_EX+$LOCK_NB )) { 	# ロック ブロックしない
			&err_html("作業用ファイルが使用中のため処理できませんでした。($idxwk)");
			exit;
		}
	}
	# -----------------------------------------------------------------------
	&html_head;
	&html_next;
	print "<HR>\n";
	print "<BLOCKQUOTE>\n";
	print "<H3>****  $bbsname  ****</H3>\n";

	print "検索用インデックス作成<br>\n";

	# 逆順 新しいものが上
	print "<HR WIDTH=90%>\n";
	seek(IDXWK, 0, 0);									# ファイルの先頭に移動
	truncate(IDXWK, 0); 								# ファイルを空にする。
	$no 			= $last_no; 						# 発言 # のカウント
	print "作成開始<br>\n";
	print "作成中 #$no<br>\n";
	while ( $no > 1 ) {
		print "作成中 #$no<br>\n"	if $no%100 == 0;
		if (my($dstr)=&get_dstr($no--)) {
			print IDXWK $dstr,"\n";
		}
	}
	print "作業用ファイル作成完了<br>\n";
	# -----------------------------------------------------------------------
	unless (open(MSGDB,">>$idxfile")) {
		print "インデックスファイルが開けませんでした。($idxfile)<br>\n";
		&html_next;
		&foot_html;
		return;
	}
	if ($useflock) {
		flock(MSGDB, $LOCK_EX);
	}
	print "インデックスファイルへ書込中 ($idxwk -> $idxfile)<br>\n";
	seek(IDXWK, 0, 0);								# ファイルの先頭に移動

	seek(MSGDB, 0, 0);								# ファイルの先頭に移動
	truncate(MSGDB, 0); 							# ファイルを空にする。
	while (<IDXWK>) {
		print MSGDB;
	}
	close(MSGDB);
	close(IDXWK);
	# -----------------------------------------------------------------------
	print "作成完了<br>\n";
	print "</BLOCKQUOTE>\n";
	print "<HR>\n";
	&html_next;
	&foot_html;
}
# ---------------------------------------------------------------------------
sub get_dstr {
	my($no)=shift;							# サブルーチンの引数を
	unless (open(MSG,"<$file$no")) {
		return;
	}
	flock(MSG,$LOCK_SH) if $useflock;		# 共有ロック

	$temp=$/;			# Input Record Separator を退避
	undef $/;			# Input Record Separator

	my($dstr)=<MSG>;	# 丸ごと入力
	close(MSG); 		# <<<<<<<<< close

	$/=$temp;			# Input Record Separator を戻す

	$dstr		=~ s/\n//g; 					#改行 を取り除く
	$dstr		=~ s/\Q$bbsname\E//g;			#ボード名称 を取り除く
	$dstr		=~ s/\Q★タイトル\E//g; 		#★タイトル を取り除く
	$dstr		=~ s/\Q★内容\E//g; 			#★内容 を取り除く
	$dstr		=~ s/\Q$q_char\E//g;			#引用マーク を取り除く
	$dstr		= &str_detag($dstr);			#タグ を取り除く
	$dstr		= &k2k'k2k($dstr);
	$dstr		=~ s/\s//g; 					#空白文字 を取り除く

	return($dstr);
}
# 検索 ---------------------------------------------------------------------
sub srch_msg {
	# -----------------------------------------------------------------------
	#											  $no		   指定開始位置
	$no 		= $last_no - $per_scr +1;	# $last_no	   最新のメッセージ
	if ( $no < 1 ) {
		$no 	= 1;
	}
	$page_top	= $no;							# $page_top    頁で最古のメッセージ
	$page_bottom	= $no + $per_scr -1;		# $page_bottom 頁で最新のメッセージ
	if ( $page_bottom > $last_no ) {
		$page_bottom	= $last_no;
	}
	# -----------------------------------------------------------------------
	&html_head;
	&html_next;
	print "<HR>\n";
	print "<BLOCKQUOTE>\n";
	print "<H3>****  $bbsname  ****</H3>\n";
	print "<HR WIDTH=90%>\n";
	if ( $r_mode eq "t" ) {
		print "<PRE>";
	}

	$keyword	= &k2k'k2k($keyword)            if $usesrch;
	open(MSGDB,"<$idxfile");
	flock(MSGDB,$LOCK_SH) if $useflock; 		# 共有ロック

	my($no) 	= $last_no;
	$db_rec 	= <MSGDB>;
	$db_no		= $db_rec;
	$db_no		=~ s/^#(\d+).*/$1/;
	while ( $db_no < $no ) {
		my($dstr)	=	&get_dstr($no--);		# メッセージから
		&srch_main($dstr);
	}
	&srch_main($_);
	while (<MSGDB>) {
		chomp;
		&srch_main($_); 						# データベースから
	}
	if ( $r_mode eq "t" ) {
		print "</PRE><HR WIDTH=90%>\n";
	}
	print "</BLOCKQUOTE>\n";
	print "<HR>\n";
	&html_next;
	&form_html;
	&foot_html;
}
# ---------------------------------------------------------------------------
sub srch_main {
	my($dstr)=shift;		  # サブルーチンの引数を

	my(@words)	= split(' ', $keyword);
	my($found)	= 0;
	if ($s_mode eq 'OR' ) { 			  # OR
		foreach $aword (@words) {
			if ($dstr =~ /\Q$aword\E/ ) {		# $aword 中のメタ文字を無効に
				$found = 1;
				last;
			}
		}
	} else {							# AND
		$found = 1;
		foreach $aword (@words) {
			unless ($dstr =~ /\Q$aword\E/ ) {	# $aword 中のメタ文字を無効に
				$found = 0;
				last;
			}
		}
	}
	unless ($found) {
		return(0);
	}
	my($no) = $dstr;
	$no 	=~ s/^#(\d+).*/$1/;
	&read_main($no);
	return(1);
}
# 読む ---------------------------------------------------------------------
sub read_bbs {
	# -----------------------------------------------------------------------
	#											  $no		   指定開始位置
	if ( $c_point > 1 && $cmd =~ /n/ ) {		# $c_point	   未読ポインタ
		$no 		= $c_point+1;
	}
	unless ( $no ) {
		$no 		= $last_no - $per_scr +1;	# $last_no	   最新のメッセージ
	}
	if ( $no < 1 ) {
		$no 		= 1;
	}
	$page_top	= $no;							# $page_top    頁で最古のメッセージ
	if ( $cmd =~ /[rc]/ ) { 					# response or 削除 'C'
		$page_bottom	= $no;
	} else {
		$page_bottom	= $no + $per_scr -1;	# $page_bottom 頁で最新のメッセージ
		if ( $page_bottom > $last_no ) {
			$page_bottom	= $last_no;
		}
	}
	# Cookie --------------------------------------------------------------
	if ( $r_mode eq 'm' && ( $c_point < $page_bottom or $c_point > $last_no )) {
		&set_cookie_bbs;
	}
	# ---------------------------------------------------------------------
	&html_head;
	&html_next;
	print "<HR>\n";
	print "<BLOCKQUOTE>\n";
	if ($cmd =~ /[d|c]/ ) {
		$del_msg_ctr	=0;
		if ($page_top == $page_bottom ) {
			$r_mode = 'm';
			print "<TABLE><TR>\n";
			print "<TD><H3>このメッセージを削除します。</H3></TD>\n";
			&next_b('z'.$page_bottom,	'削除');	# 次は、削除
			print "</TR></TABLE>\n";
		} else {
			$r_mode = 't';
			print "<H3>削除するメッセージの番号を選び、内容を確認してください。</H3>";
		}
	} else {
		if ($cmd =~ /x/ ) {
			print "<H3>書きこみました。</H3>\n";
		}
		print "<H3>****  $bbsname  ****</H3>\n";
	}
	if ($cmd =~ /w/ ) {
		&form_html;
		&foot_html;
		return;
	}
	if ( $r_mode eq "t" ) {
		print "<PRE>";
	}
	if ( $c_point >= $last_no && $cmd =~ /n/ ) {
		print "新しいメッセージは、ありません。<BR>\n";
	} elsif ( $o_mode eq "f" ) {				# 正順 新しいものが下
		print "<HR WIDTH=90%>\n";
		$no 	= $page_top;					# page_top -> $page_bottom
		while ( $page_bottom	>= $no ) {
			&read_main($no);
			$no = $no + 1;
		}
	} else {									# 逆順 新しいものが上
		print "<HR WIDTH=90%>\n";
		$no 	= $page_bottom; 				# page_bottom ... page_top
		while ( $page_top  <= $no ) {
			&read_main($no);
			$no = $no - 1;
		}
	}
	if ( $r_mode eq "t" ) {
		print "</PRE><HR WIDTH=90%>\n";
	}
	if ($cmd =~ /[d]/ ) {
		if ( $del_msg_ctr  == 0 ) {
			print "<H3>削除できるメッセージがありませんでした。</H3>";
		}
	}
	print "</BLOCKQUOTE>\n";
	unless ( $cmd =~ /[rx]/) {
		unless ( $c_point >= $last_no && $cmd =~ /n/ ) {
			&html_next;
		}
	}
	print "<HR>\n";
	&form_html;
	&foot_html;
}
# ---------------------------------------------------------------------------
sub read_main {
	my($no)=$_[0];							# サブルーチンの引数を
	my(@temp);
	unless (open(MSG,"<$file$no")) {
		return;
	}
	flock(MSG,$LOCK_SH)    if $useflock;	# 共有ロック
	my($i)=0;
	while (<MSG>) {
		if ( /^<BR>\n/ && $i == 1 ) {		# ver.006-007 データ互換
			$temp[0] =~ s/\n/<BR>\n/;		# ver.006-007 データ互換
		} else {
			s/^<HR.*?>\n//; 				# ver.009 データ互換
			$temp[$i]=$_;
			$i++;
		}
	}
	close(MSG);
	if ($temp[0] =~ /^<!-- /) {
		return;
	}
	my($dd,$tt)=($temp[1],$temp[2]);
	$tt  =~ s/<BR>\n//;
	if ($d_mode and &not_author($dd)) {
		return;
	}
	if ( $r_mode eq 't' ) { 						# タイトル表示
		# ) YY/MM/DD  をさがして日付だけを取出す。
		$dd  =~ s/^.*\)\s([\d\/]+)\s.*\n/	$1	/;
		if ( $d_mode eq 'd' ) {
			$del_msg_ctr++;
			print "<a href=\"$cgi_name?cmd=c$no\">$no</A>$dd$tt\n";
		} else {
			print "<a href=\"$cgi_name?cmd=${o_mode}m$no\">$no</A>$dd$tt\n";
		}
	} else {										# 内容表示
		if ($last_no) { 							# #123/999 最新 # を付加
			if ($s_mode) {
				$temp[0] =~ s/^(#)(\d+)/<a href=\"$cgi_name?cmd=${o_mode}m$2\">#$2<\/A>\/$last_no/;
			} else {
				$temp[0] =~ s/^(#\d+)/$1\/$last_no/;
			}
		}
		print @temp;
		print "<DIV ALIGN=RIGHT><FONT SIZE=2>";
		print "|<A HREF=\"$cgi_name?cmd=".$o_mode.$r_mode."r".$no."\">Re:#$no</A>|";
		print "</FONT></DIV>\n";
		print "<HR WIDTH=90%>\n";
		if ( $cmd =~ /r/ ) {
			$tt    = &str_detag($tt);
			$tt    =~ s/^(Re:#\d+>)*//;
			$title = "Re:#$no>$tt";
			$title =~ s/(.+) (.+)/$1/;
			foreach (@temp) {
				if (/<PRE>/) {
					$pre_mode="on";
					&set_pre;
				}
				$_ = &str_detag($_);			# tag を除去(最短一致)
				$comment = $comment . $q_char . $_;
			}
		}
	}
}
# ---------------------------------------------------------------------
sub get_cookie {
	my(@cookie) = split("; ", $ENV{'HTTP_COOKIE'});
	my($cname, $value);
	foreach (@cookie) {
		($cname, $value) = split("=", $_);
		if ($cname eq 'NickName') {
			($name,$email,$hp) = split("&",$value); # フィールド毎に分割
		}
		if ($cname eq 'BBS') {
			if ($c_point <= 1) {
				($c_point,$c_o_mode,$c_r_mode) = split("&",$value);
													# フィールド毎に分割
			}
		}
	}
	$name	  = &str_decode_cookie($name);
	$email	  = &str_decode_cookie($email);
	$hp 	  = &str_decode_cookie($hp);

	$c_point  = &str_decode_cookie($c_point);
	$c_o_mode = &str_decode_cookie($c_o_mode);
	$c_r_mode = &str_decode_cookie($c_r_mode);
	# c_point を $pfile から読み込む --------------------------------
	# 例外の user の一覧を参照する。たとえば guest は cookie だけとか
	if ($usepfile) {
		my($remote_user) = $ENV{'REMOTE_USER'};
		unless (grep(/$remote_user/, @guests)) {
			&open_pfile;
			while (<PFILE>) {
				if (/^$remote_user:/i ) {
					chomp;
					(undef,$c_point,undef) = split(':');  # 未読ポインタ
					last;
				}
			}
		}
		&close_pfile;
	}
}
# Set-Cookie -----------------------------------------------------------
sub set_cookie_bbs {
	my($new_point);
	if ($last_no < $page_bottom) {
		$new_point	= &str_encode_for_cookie($last_no);
	} else {
		$new_point	= &str_encode_for_cookie($page_bottom);
	}
	$c_o_mode		= &str_encode_for_cookie($o_mode);	# o_mode : 'f','b'
	$c_r_mode		= &str_encode_for_cookie($r_mode);	# r_mode : 't','m'
	# c_point を $pfile へ書き込む -------------------------------------
	if ($usepfile) {
		my($remote_user) = $ENV{'REMOTE_USER'};
		&open_pfile;
		my($pos) = tell PFILE;
		while (<PFILE>) {
			if (/^$remote_user:/ ) {
				chomp;
				seek(PFILE, $pos, 0);			# ファイルの途中の位置へ
				last;
			}
			$pos	=tell PFILE;
		}
		# レコードの形式 : usrid:99999999:YY/MM/DD hh:mm\n
		my($sec,$min,$hour,$mday,$mon,$year)=localtime;
		printf PFILE "%s:%8.8d:%2.2d\/%2.2d\/%2.2d %2.2d:%2.2d:%2.2d %-20.20s\n", 
					  $remote_user, $new_point,
					  $year%100,$mon+1,$mday,$hour,$min,$sec,
					  $name;
		&close_pfile;
	}
	# Set-Cookie --------------------------------------------------
	# cookie の有効期限を GMT で 1000 日後に設定 60秒*60分*24時間*1000日
	my($expire) 	= &expire_gmt(60*60*24*1000);
	# path は省略値
	my($cookie) 	="Set-Cookie: "
					."BBS=$new_point&$c_o_mode&$c_r_mode; "
					."expires=$expire; "
					."\n";
	print $cookie;
}
# ---------------------------------------------------------------------
sub set_cookie_name {
	my($t_name) 	= &str_encode_for_cookie($name);
	my($t_email)	= &str_encode_for_cookie($email);
	my($t_hp)		= &str_encode_for_cookie($hp);
	my($new_value)	= "NickName=$t_name&$t_email&$t_hp";

	# 同じ値のときは、パス!
	my(@cookie) 	= split("; ", $ENV{'HTTP_COOKIE'});
	foreach (@cookie) {
		if ($_ eq $new_value ) { 
			# まあ、有効期限が切れたらしょうがないよね(^^;;;
			return;
		}
	}
	# Set-Cookie --------------------------------------------------
	# cookie の有効期限を GMT で 1000 日後に設定 60秒*60分*24時間*1000日
	my($expire) 	= &expire_gmt(60*60*24*1000);
	my($path)		='/';
	my($cookie) 	="Set-Cookie: "
					."$new_value; "
					."expires=$expire; "
					."path=$path; "
					."\n";
	print $cookie;
}
# ---------------------------------------------------------------------
sub expire_gmt {
	my($esec)=$_[0];					  # サブルーチンの引数を
	my($sec,$min,$hour,$day,$mon,$year,$wday)= gmtime( time+$esec );
	#	10 Aug 2000 12:34:56 GMT		;RFC1123
	#	Wdy, 10-Aug-2000 12:34:56 GMT	;RFC822 では Wdy は省略可なのだが...
	my($str) =sprintf("%s, %2.2d-%s-%4.4d %2.2d:%2.2d:%2.2d GMT",
					   &getweek($wday),$day,&getmonth($mon),$year+1900,
					   $hour,$min,$sec);
	return($str);
}
# ---------------------------------------------------------------------
sub getmonth{
	my($mon)	=shift; 					 # サブルーチンの引数を
	my(@month) = (	"Jan","Feb","Mar","Apr","May","Jun",
					"Jul","Aug","Sep","Oct","Nov","Dec" );
	return($month[$mon]);
}
# ---------------------------------------------------------------------
sub getweek{
	my($wday)	=shift; 					 # サブルーチンの引数を
	my(@week)  = (	"Sun", "Mon","Tue","Wed","Thu","Fri","Sat" );
	return($week[$wday]);
}
# ---------------------------------------------------------------------
sub open_pfile {
	unless (open(PFILE,"+<$pfile")) {
		&err_html("未読ポインタにアクセスできませんでした。($pfile)");
		exit;
	}
	flock(PFILE, $LOCK_EX)	if $useflock;					# 排他ロック
}
# ---------------------------------------------------------------------
sub close_pfile {
	close(PFILE);
}
# ---------------------------------------------------------------------
sub html_head {
	print "Content-type: text/html; charset=Shift_JIS\n\n";
	print <<END;
		<HTML>
		<HEAD><META HTTP-EQUIV="Pragma" CONTENT="no-cache">
		<TITLE>$bbsname</TITLE></HEAD>
		$body
END
	if ($welcome && $name) {
		print "<H3>$name さん ようこそ! お待ちしていました!</H3>";
	}
	print $head;
	print "<DIV ALIGN=RIGHT>$time</DIV>";
}
# ---------------------------------------------------------------------
sub html_next {
	print "<CENTER>\n<TABLE><TR>";
	$back_no	= $page_top - $per_scr; 	# $page_top 頁で最古の No.
	$oldest_no	= $last_no	- $msg_max + 1;
	if ( $oldest_no < 1 ) {
		$oldest_no	= 1;
	}
	if ( $back_no < 1 ) {
		$back_no	= 1;
	}
	if ( $back_no < $oldest_no ) {
		$back_no	= $oldest_no;
	}
	if ( $back_no < $page_top ) {
		&next_b("$o_mode$r_mode$back_no",	"#$back_no -");
	}
	print <<END;
		<TD><FORM METHOD="GET" ACTION="$back_html">
		<INPUT TYPE="submit" VALUE="終了"></FORM></TD>
END
	if ( $r_mode eq "m" ) {
		&next_b( $o_mode."t".$page_top, 		'タイトル一覧');
	} else {
		&next_b( $o_mode."m".$page_top, 		'内容表示');
	}
	$foword_no	= $page_bottom + 1; 		# $page_bottom 頁で最新の No.
	if ( $last_no > $foword_no ) {
		&next_b( $o_mode.$r_mode.$foword_no,	"#$foword_no -");
	}
	&next_b( $o_mode.$r_mode, '最新の '.$per_scr.' メッセージ');
	if ( $o_mode eq "b" ) {
		&next_b('f'.$r_mode.$page_top,			'表示順変更');
	} else {
		&next_b('b'.$r_mode.$page_top,			'表示順変更');	 
	}
	# dt 削除のタイトル表示
	# c  削除の確認 			c999
	# z  削除
	if ( $delmsg ) {
		if	($d_mode eq 'c') {
		} elsif ($d_mode ne 'd') {
			&next_b("dt", '削除');						# 次は、削除用一覧
		}
	}
	my($andchked)='CHECKED';
	my($orchked) ='';
	if ( $s_mode eq "OR" ) {
		$andchked	 ='';
		$orchked	 ='CHECKED';
	}
	print "</TR>";
	if ($usesrch) {
		print <<END;
		<TR>
		<TD COLSPAN=6>
		<FORM METHOD="$method" ACTION="$cgi_name">
		<INPUT TYPE="hidden" NAME="cmd" VALUE="s$o_mode$r_mode">
		<INPUT TYPE="text" SIZE=30 NAME="Keyword" VALUE="$FORM{'Keyword'}">
		<INPUT TYPE="submit" VALUE="検索">
		<INPUT TYPE="radio" NAME="srchmode"  VALUE="AND" $andchked >AND
		<INPUT TYPE="radio" NAME="srchmode"  VALUE="OR"  $orchked >OR
		</FORM>
		</TD>
		</TR>
END
	}
	print "</TABLE></CENTER>";
}
# ---------------------------------------------------------------------
sub next_b {
	local($arg,$msg)=@_;					# サブルーチンの引数を
	print <<END;
		<TD><FORM METHOD="GET" ACTION="$cgi_name">
		<INPUT TYPE="hidden" NAME="cmd" VALUE="$arg">
		<INPUT TYPE="submit" VALUE="$msg"></FORM></TD>
END
}
# ---------------------------------------------------------------------
sub form_html {
	if ($d_mode) {
		return;
	}
	$title	 =~ s/<.*?>//ge;				# tag を除去 (最短一致)
	$comment =~ s/<.*?>//ge;				# tag を除去 (最短一致)
	unless ( $hp ) {
		$hp=$dflt_hp;
	}
	unless ( $email ) {
		$email=$dflt_email;
	}
	my($r);
	print $border;
	if ($cmd =~ /r/ ) {
		print "Response to #$r_no<BR><BR>\n";
		$r="r$r_no";
	}
	my($email_need)='(省略不可)';
	unless ($need_email) {
		$email_need='(よろしければ)';
	}
	if ($m_mode eq 'g') {
		$method = 'GET';
	} else {
		$method = 'POST';
	}
	my($pre_on_check,$pre_off_check);
	if ($pre) {
		$pre_on_check ='CHECKED';
	} else {
		$pre_off_check ='CHECKED';
	}
	print <<END;
		<FORM METHOD="$method" ACTION="$cgi_name">
		<INPUT TYPE="hidden" NAME="cmd" VALUE="u$o_mode$r_mode$r">
		おなまえ(ニックネーム)<BR>
		<INPUT TYPE="text" SIZE=50 NAME="Name" VALUE="$name"><BR>
		メールアドレス$email_need<BR>
		<INPUT TYPE="text" SIZE=50 NAME="E_mail" VALUE="$email"><BR>
		ホームページアドレス(よろしければ)<BR>
		<INPUT TYPE="text" SIZE=50 NAME="HomePage" VALUE="$hp"><BR><BR>
		★タイトル<BR>
		<INPUT TYPE="text" SIZE=50 NAME="Title" VALUE="$title"><BR>
		★内容<BR>
		<TEXTAREA NAME="Comment" ROWS="$form_rows" COLS="$form_cols" >$comment</TEXTAREA><BR>
		<INPUT TYPE="radio" NAME="pre_mode" VALUE="on"	$pre_on_check >整形済入力(空白、改行が有効) 
		<INPUT TYPE="radio" NAME="pre_mode" VALUE="off" $pre_off_check >未整形入力(改行のみ有効)
		<CENTER>
		<INPUT TYPE="submit" VALUE="書込">
		<INPUT TYPE="reset" VALUE="取消">
		</CENTER>
		</FORM>
		<HR><!-- ===================================== -->
END
}
# ---------------------------------------------------------------------
sub foot_html {
	print <<END;
$tail
		<FONT SIZE=-1>
		<A HREF="http://www2d.biglobe.ne.jp/~gama/cgi/index.cgi">$copyright</a>
		</FONT>
		<BR><BR>
		</BODY></HTML>
END
}
# ---------------------------------------------------------------------
sub err_html	{
	print "Content-type: text/html\n\n";
	my($errmsg)=$_[0];						# サブルーチンの引数
	my($errtit,$errback);
	if ($d_mode) {
		$errtit='削除できませんでした。';
		$errback=$cmd;
		$errback=~ s/z/c/;
	} elsif ($cmd =~ /i/ ) {
		$errtit='エラーが発生しました。';
		$errback=$cmd;
		$errback=~ s/i//;
	} else {
		$errtit='書き込みにエラーがありました';
		$errback=$cmd;
	}
	print <<END;
		<HTML><HEAD><TITLE>$errtit</TITLE></HEAD>
		$body
		<H2>$errtit</H2>
		<HR><!-- ===================================== -->
$errmsg
		<CENTER>
		<FORM METHOD="GET" ACTION="$cgi_name">
		<INPUT TYPE="hidden" NAME="cmd" VALUE="$errback">
		<INPUT TYPE="submit" VALUE="戻る"></FORM>
		</CENTER>
		<HR><!-- ===================================== -->
END
	&form_html;
	&foot_html;
}
# ---------------------------------------------------------------------
sub str_detag {
	local($str)=$_[0];						# サブルーチンの引数を
	$str=~ s/<.*?>//ge; 					# tag を除去 (最短一致)
	$str=~ s/&amp;/&/g; 					# &
	$str=~ s/&lt;/</g;						# <
	$str=~ s/&gt;/>/g;						# >
	return($str);
}
# ---------------------------------------------------------------------
sub str_decode_from_form {
	local($str)=$_[0];						# サブルーチンの引数を
	$str=~ s/\+/ /g;						# + を space へ
	$str=~ s/%(..)/pack("c",hex($1))/ge;	# decode
	$str=~ s/\r//g; 						# LF を削除
	return($str);
}
# ---------------------------------------------------------------------
sub str_conv_for_html {
	local($str)=$_[0];						# サブルーチンの引数を
	$str=~ s/&/&amp;/g; 					# &
	$str=~ s/</&lt;/g;						# <
	$str=~ s/>/&gt;/g;						# >
	return($str);
}
# ---------------------------------------------------------------------
sub str_decode_cookie {
	local($str)=$_[0];						# サブルーチンの引数を
	$str=~ s/^\w+=//;						# = までを削除・・・
	$str=~ s/%(..)/pack("c",hex($1))/ge;	# decode
	return($str);
}
# ---------------------------------------------------------------------
sub str_encode_for_cookie {
	local($str)=$_[0];						# サブルーチンの引数を
	$str=~ s/ /%20/g;						# encode
	$str=~ s/,/%2C/g;						# encode
	$str=~ s/;/%3B/g;						# encode
	$str=~ s/&/%26/g;						# encode
	return($str);
}
# ---------------------------------------------------------------------
# check_url URL をアクセスしてチェック
#	エラーメッセージを返す
# ---------------------------------------------------------------------
sub check_url {
	my($url)=$_[0]; 						# サブルーチンの引数を
	unless ($chkurl) {
		return (0); 						# OK
	}
	my($r)= &chkurl'chkurl($url);
	if ($r =~ /\s*(301|302)\s*/ ) {
		$r = &chkurl'chkurl($url.'/');
	}
	if ($r =~ /200/ ) {
		return 0;							# OK
	}
	return $r;								# NG
}

戻る