#!/usr/bin/perl
#	↑サーバーの「perl」のパスを指定。
#	駄目なら｢#!/usr/local/bin/perl5｣
#	それでも駄目ならサーバー管理者に問い合わせて下さい。

###########################################################################
##--------------------- Chama's MEMO CGI v2.07 ---------------------------
##   (C)Copyright 2001 by Chama.ne.jp
##       E-mail:master@chama.ne.jp
##       HP:http://www.chama.ne.jp
###########################################################################
#v1.1 データ保存時に一部の不具合があった点を修正
#v2.0 簡易カウンタ機能を追加
#v2.1 更新日表示機能を追加
#v2.02 不要な改行を削除、著作権リンク部のバグ修正
#v2.03 最終更新日の表示を時間まで指定できるよう修正
#v2.04 入力フォームのサイズを変更できるよう修正（携帯に対応）
#v2.05 HTMLタグの有効・無効を設定できるよう修正
#v2.06 入力時の改行コードの<br>へ変換して表示かどうか設定できるよう修正
#v2.07 スタイルシート設定機能を追加

#---------- 免責事項 -----------------------------------------------------#
# １．このプログラムはフリーソフトですが、著作権はChama-Net事務局中川督之にあります。
#　　いかなる場合であっても、有料で売買、設置、使用、変更等を行ってはいけません。
#　　また、この著作権表示、ＣＧＩを画面に表示した時のＣｈａｍａ-Ｎｅｔの表示の変更は認めません。
# 　　（カラーの変更や極端な改行、スクロール不可等により実質的に著作権の表示を消すころも認めていません。）
# ２．このプログラムを使用したことによる一切の損害等は保障致しません。　
# ３．その他についてはChama-Net事務局にお問い合わせ下さい。
#　　連絡先　http://www.chama.ne.jp
#　　E-mail　master@chama.ne.jp

#---------- ↓初期設定項目 -----------------------------------------------#
#本文情報ファイルの指定
$file = 'data.dat';

#カウンタ、更新日情報ファイルの指定
$cnt_file = 'data2.dat';

#カウンタの表示（する＝yes、しない＝no）
$cnt_ok = 'no';

#更新日の表示（する＝yes、しない＝no）
$date_ok = 'no';

#曜日の表示（する＝yes、しない＝no）
$time_week = 'no';

#更新時間の表示（1=時：分：秒、2=時：分、3=表示しない）
$time_time = 2;

#パスワードの指定
$pass = '1122';

#このＣＧＩの名前
$cgi = 'memo.cgi';

#タイトルの指定
$title = 'レッスンインフォメーション';

#文字サイズの指定
$word_size=2;

#文字色の指定
$word_color='#666666';

#壁紙の指定（URLを’’間に入れる　例：http://・・・・○○.gif　色指定の場合は空白''に）
$bg_file = '';

#壁紙が無ければ背景色を使用
$bg_color = '#ffffff';

#入力フォームのサイズ指定（携帯の場合は幅を30、行は5を推奨）
#幅の指定
$form_cols = 40;
#行の指定
$form_rows = 10;

#入力されたHTMLタグの設定
#1=有効：タグが有効になり、画像表示なども可能、URL・E-mailはそのまま表示（リンクされない）
#2=無効：タグが無効になり、ソースが表示される、URL・E-mailは自動でリンクされる
$html_prev = 1;

#改行の変換指定
#1=変換：入力時の改行が<br>に変換される
#2=無変換：入力時の改行を無視（通常のHTMLどおりソースの改行になる、<table>タグを使用する場合はこちら）
$html_br = 1;

#スタイルシートの指定（''間に色を指定）
	#scrollbar-Track-Color:
	$track_color = '#cccccc';

	#scrollbar-Face-Color:
	$face_color = '#ffffff';

	#scrollbar-3dLight-Color:
	$dlight_color = '#cccccc';

	#scrollbar-Arrow-Color:
	$arrow_color = '#cccccc';

#---------- ↓プログラム--------------------------------------------------#
require './jcode.pl';
&decode;

#ファイルロック
&o_lock;

&f_open;
&c_open;
&c_write;
if($in_flag == 2){
	&check;
	&write;
	&kanryou;
}

#ロック解除
&c_lock;

if($in_flag == 1){
	$time = time;
	$now = &time($time);
	&check;
	&form;
}

&prev;

#-----サブルーチン-----------------------------------------------------#
#デコード処理-----------------------------------------------
sub decode{
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN, $buff, $ENV{'CONTENT_LENGTH'});
	} else {
		$buff = $ENV{'QUERY_STRING'};
	}
	@pairs = split(/&/,$buff);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		&jcode'convert(*value,'sjis');
		$value =~ s/[\r\t\f]//g;
		$in{$name} = $value;
	}
	$in_pass = $in{'in_pass'};
	$in_text = $in{'in_text'};
	$in_flag = $in{'in_flag'};
}
#パスワードチェック---------------------------------------
sub check{
	unless($in_pass){
		$err=1;
		&err;
	}
	unless($in_pass eq $pass){
		$err = 2;
		&err;
	}
}
#データ保存-----------------------------------------------
sub write{
	open FOUT, ">$file" or die "$file オープン失敗";
	print FOUT $in_text;
	close FOUT;
}
#fileの読込み---------------------------------------------
sub f_open{
	open FIN, "$file" or die "$file オープン失敗";
		@f_data = ();
		while (<FIN>){
			$_ =~ s/[\r\n\t\f]//g;
			@f_data = (@f_data,$_);
		}
	close FIN;
}
#カウンタ、更新日情報ファイルを開く-------------------------
sub c_open{
	open CNTIN,"$cnt_file" or die "$cnt_file オープン失敗";
		while (<CNTIN>){
			chomp $_;
			($cnt,$date) = split(/<>/,$_);
		}
	#カウントファイルを閉じる
	close CNTIN;
}
#カウンタ情報の更新----------------------------------------
sub c_write{
	$time = time;
	$now = &time($time);
	open CNTOUT, ">$cnt_file" or die "Cannot open $cnt_file:s!";
	unless($in_flag > 0){
		$cnt++;
		print CNTOUT $cnt,"<>",$date,"\n";
	}else{
		print CNTOUT $cnt,"<>",$now,"\n";
	}
	close CNTOUT;
}
#現在時刻の把握---------------------------------------------
sub time{
	$time = $_[0];
	($sec,$min,$hou,$mda,$mon,$yea,$wda,$yda,$isd) = localtime($time);
	$year_now = $yea + 1900;
	$date_now = sprintf("%02d/%02d/%02d",$yea + 1900,$mon + 1,$mda);
	$youbi_now = ('(日)','(月)','(火)','(水)','(木)','(金)','(土)') [$wda];
	$timesec_now = sprintf("%02d:%02d:%02d",$hou,$min,$sec);
	$timetime_now = sprintf("%02d:%02d",$hou,$min);

	$now = '';
	$now .= $date_now;
	if($time_week eq 'yes'){
		$now .= $youbi_now;
	}
	if($time_time == 2){
		$now .= '　';
		$now .= $timesec_now;
	}elsif($time_time == 1){
		$now .= '　';
		$now .= $timetime_now;
	}
	$now2 = $date_now;
	$now2 .= $youbi_now;
	$now2 .= $timesec_now;
	return($now);
}

#完了画面の表示--------------------------------------------
sub kanryou{
	&top;
	print "<table border=0 bgcolor=$word_color>\n";
	print "<tbody>\n";
	print "<tr>\n";
	print "<td align=center bgcolor=#FFFFFF>\n";
	print "<font size=3 color=$word_color>\n";
	print "入力完了";
	print "</font>\n";
	print "</td>\n";
	print "</tr>\n";
	print "</tbody>\n";
	print "</table>\n";
	print "<br><br>\n";
	print "<A href=$cgi>プレビュー</A>\n";
	&last;
}

#入力画面の表示-------------------------------------------
sub form{
	&top;
	print "<table border=0 bgcolor=$word_color>\n";
	print "<tbody>\n";
	print "<tr>\n";
	print "<td align=center bgcolor=#FFFFFF>\n";
	print "<font size=3 color=$word_color>\n";
	print "入力画面";
	print "</font>\n";
	print "</td>\n";
	print "</tr>\n";
	print "</tbody>\n";
	print "</table>\n";
	print "<br><br>\n";
	print "現在時刻(参考）：$now2";
	print "<br><br>\n";
	print "<form action=$cgi method=post>\n";
	print "<TEXTAREA name=\"in_text\" rows=\"$form_rows\" cols=\"$form_cols\">\n";
	foreach $p_file(@f_data){
		print $p_file;
		print "\n";
	}
	print "</TEXTAREA>\n";
	print "<br>\n";
	print "<input type=hidden name=in_flag value=2>\n";
	print "<input type=\"hidden\" size=\"10\" name=\"in_pass\" value=\"$in_pass\">\n";
	print "<INPUT type=\"submit\" value=\"修正（送信）\">\n";
	print "</form>\n";
	&last;
}

#プレビュー画面の表示--------------------------------------
sub prev{
	&top;
	print "<table border=0 width=95%>\n";
	print "<tbody>\n";
	print "<tr>\n";
	print "<td>\n";
	print "<font size=$word_size color=$word_color>\n";
	foreach $p_file(@f_data){
		if($html_prev == 2){
			$p_file =~ s/\&/&amp\;/g;
			$p_file =~ s/</&lt\;/g;
			$p_file =~ s/>/&gt\;/g;
			$p_file =~ s/\"/&quot\;/g;
			$p_file = &link($p_file);
		}
		print $p_file;
		if($html_br == 1){
			print "<br>\n";
		}else{
			print "\n";
		}
	}
	print "</td>\n";
	print "</tr>\n";
	print "<tr>\n";
	print "<td align=right>\n";
	print "<form action=$cgi method=post>\n";
#	print "<font size=2 color=#ccccff><A href=\"http://www.chama.ne.jp\" target=\"new\">めもCGI by Chama-Net</A></font>\n";
	print "<br>\n";
	print "<input type=hidden name=in_flag value=1>\n"; 
	print "<input type=password size=10 name=in_pass>\n";
	print "<INPUT type=submit value=管理>\n";
	print "</form>\n";
	print "</font>\n";
	print "</td>\n";
	print "</tr>\n";
	print "</tbody>\n";
	print "</table>\n";
	&last;
}

#エラー画面の表示--------------------------------------------
sub err{
	#ロック解除
	&c_lock;

	&top;
	print "<table border=0 bgcolor=$word_color>\n";
	print "<tbody>\n";
	print "<tr>\n";
	print "<td align=center bgcolor=#FFFFFF>\n";
	print "<font size=3 color=$word_color>\n";
	print "入力エラーです。";
	print "</font>\n";
	print "</td>\n";
	print "</tr>\n";
	print "</tbody>\n";
	print "</table>\n";
	print "<br><br>\n";
	if($err == 1){
		print "パスワードが入力されていません。";
	}elsif($err == 2){
		print "パスワードに誤りがあります。";
	}
	&last;
}
#入力されたコメント中にＵＲＬやE-mailがある場合にはリンクに変換-----------------
sub link{
	# $str の中の URI(URL) にリンクを張った $result を作る
	$str= $_[0];

	$tag_regex_ = q{(?:[^"'<>]|"[^"]*"|'[^']*')*(?:>|(?=<)|$(?!\n))}; #'}}}

	$http_URL_regex =
	q{\b(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f} .
	q{][0-9A-Fa-f])*@)?(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)} .
	q{*[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.} .
	q{[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f]} .
	q{[0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-} .
	q{Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f} .
	q{])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)} .
	q{*)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])} .
	q{*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} .
	q{)?};

	$ftp_URL_regex =
	q{\bftp://(?:(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} .
	q{(?::(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?@)?(?} .
	q{:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)*[a-zA-Z](?:[-a-zA-} .
	q{Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9]*)?} .
	q{(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:/(?} .
	q{:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*(?:;type=[} .
	q{AIDaid])?)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9} .
	q{A-Fa-f])*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A} .
	q{-Fa-f])*)?};

	$mail_regex =
	q{(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\\} .
	q{\[\]\000-\037\x80-\xff])|"[^\\\\\x80-\xff\n\015"]*(?:\\\\[^\x80-\xff][} .
	q{^\\\\\x80-\xff\n\015"]*)*")(?:\.(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x} .
	q{80-\xff]+(?![^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff])|"[^\\\\\x80-} .
	q{\xff\n\015"]*(?:\\\\[^\x80-\xff][^\\\\\x80-\xff\n\015"]*)*"))*@(?:[^(} .
	q{\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\\\[\]\0} .
	q{00-\037\x80-\xff])|\[(?:[^\\\\\x80-\xff\n\015\[\]]|\\\\[^\x80-\xff])*} .
	q{\])(?:\.(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,} .
	q{;:".\\\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\\\x80-\xff\n\015\[\]]|\\\\[} .
	q{^\x80-\xff])*\]))*};

	$text_regex = q{[^<]*};

	$result = '';  $skip = 0;
	while ($str =~ /($text_regex)($tag_regex)?/gso) {
		last if $1 eq '' and $2 eq '';
		$text_tmp = $1;
		$tag_tmp = $2;
		if ($skip) {
			$result .= $text_tmp . $tag_tmp;
			$skip = 0 if $tag_tmp =~ /^<\/[aA](?![0-9A-Za-z])/;
		} else {
			$text_tmp =~ s{($http_URL_regex|$ftp_URL_regex|($mail_regex))}
				{my($org, $mail) = ($1, $2);
				(my $tmp = $org) =~ s/"/&quot;/g;
				'<A HREF="' . ($mail ne '' ? 'mailto:' : '') . "$tmp\">$org</A>"}ego;
			$result .= $text_tmp . $tag_tmp;
			$skip = 1 if $tag_tmp =~ /^<[aA](?![0-9A-Za-z])/;
			if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) {
				$str =~ /(.*?(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$))/gsi;
				$result .= $1;
			}
		}
	}
	return($result);
}

#HTMLprintサブルーチン---------------------------------------
sub top{
	print "Content-type:text/html\n\n";
	print "<html><head><title>$title</title>\n";
	print "<STYLE type=text/css>\n";
	print '<!--',"\n";
	print 'body {scrollbar-Track-Color:',$track_color,';',"\n";
	print 'scrollbar-Face-Color:',$face_color,';',"\n";
	print 'scrollbar-Shadow-Color:',$shadow_color,';',"\n";
	print 'scrollbar-DarkShadow-Color:',$darkshadow_color,';',"\n";
	print 'scrollbar-Highlight-Color:',$hightlight_color,';',"\n";
	print 'scrollbar-3dLight-Color:',$dlight_color,';',"\n";
	print 'scrollbar-Arrow-Color:',$arrow_color,';}',"\n";
	print 'INPUT{',"\n";
	print 'color : blown;border-width : 1px;border-style : solid;border-color : navy;}',"\n";
	print '-->',"\n";
	print "</STYLE>\n";
	print "</head>\n";
	if($bg_file){
		print "<body background=$bg_file>\n";
	}else{
		print "<body bgcolor=$bg_color>\n";
	}
	print "<font size=$word_size color=$word_color>\n";
	if($date_ok eq 'yes'){
		print "最終更新：",$date,"\n";
	}
	if($cnt_ok eq 'yes'){
		print "Count：",$cnt,"\n";
	}
	print "<center>\n";
}

sub last{
	print "</font>\n";
	print "</center>";
	print "</body></html>\n";

	exit;
}
#データロック------------------------------------------------
sub o_lock{
	open(LOCK,">data.lock");
	flock(LOCK,2);
}
#ロック解除--------------------------------------------------
sub c_lock{
	close(LOCK);
}