#!/usr/bin/perl

# �\���i�����̓p�[�~�b�V����()���͏��L�Ҍ�����CGI�������T�[�o�̏ꍇ�j
#|-- tl11s.cgi   755(700)
#|-- jcode.pl    644(600)
#|-- bbs.dat     666(600)
#|-- count.txt   666(600)
#|-- session.dat 666(600)
#
#�����₫���C�g�̓V���v���ȋ@�\�̈�s�f���‚ł��B
#�g�p�A�����A�Ĕz�z�Ɉ�؂̐����͂���܂���B
#08/24 2000 �^�ӐT
############################### �‹��ݒ� ###############################

$title = '�����₫���C�g+�g�C��';     # �f���‚̖��O

$bbsurl = './tl11toto.cgi';       # ���̃X�N���v�g��URL�i���Ύw����j

$bbsfile = './bbs.dat';        # �L�^�t�@�C���̃p�X

$counterfile = './count.txt';  # �J�E���^�t�@�C���̃p�X

$jcpl = './jcode.pl';          # ���{��R�[�h�ϊ����C�u�����̃p�X

# �o��HTML�̕����F��w�i�i�{�f�B�^�O�j
$body = '<body text="#000000" bgcolor="#aabbcc" link="#1775a2" vlink="#1775a2" alink="#cc0000">';

$namecolor = '#d53d8e';        # ���O�̐F

$textcolor = '#333333';        # ���e�̐F

$datecolor = '#666666';        # ���e�����̐F

$max = 100;                    # �\������

$maxlength = 3*1024;           # ���̓f�[�^���v�̍ő�l(byte)

$time_dif = 9*60*60;           # �O���j�b�W�W�����Ƃ̎����i���{���Ԃ�\������ꍇ9*60*60�j

$sessionfile='./session.dat';  # �Q���ҋL�^�t�@�C��

$sessiontime=5*60;             # �Q���ҕ\���L������(sec)

############################### �S�̏��� ###############################

&get_time;
if ($ENV{'REQUEST_METHOD'} eq "POST") {
	&decode;
	if($FORM{'clean'}) { &clean;}
	elsif($FORM{'pclean'}&&$FORM{'cheche'}) { &pclean;}
	else{
		&kinsi;
		&write if($FORM{'value'});
	}
}
&html;
exit;

############################### �T�u���[�`�� ###############################

sub get_time{ #-------------------- �������� --------------------#
	$time = time;
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($time + $time_dif);
	$mon++;
	$wday = ('��','��','��','��','��','��','�y')[$wday];
	$date_now = sprintf( "%02d/%02d($wday)%02d:%02d",$mon,$mday,$hour,$min);
}

sub decode{ #-------------------- �f�R�[�h --------------------#
	return if($ENV{'CONTENT_LENGTH'} > $maxlength);
	require "$jcpl";
	read(STDIN, $buf, $ENV{'CONTENT_LENGTH'}); 
	foreach (split(/&/,$buf)) {
		($name, $value) = split(/=/,$_);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		&jcode'convert(*value,'sjis');
		$value =~ s/\r|\n//g;
#		$value =~ s/&/&amp\;/g;
#		$value =~ s/</&lt;/g;
#		$value =~ s/>/&gt;/g;
		$value =~ s/\t:/  :/g; 
		$FORM{$name} = $value;
	}
}

sub html{ #-------------------- HTML�o�� --------------------#
	&counter; # HTML���̔C�ӂ̏ꏊ��$count��u���Ƃ����ɃJ�E���g�����\������܂�
	&session; # HTML���̔C�ӂ̏ꏊ��$member��u���Ƃ����ɎQ���҂��\������܂�
	print "Content-type: text/html\n\n";
	print <<"_HTML_";
<html><head><title>$title</title></head>
$body
<font size=4><b>$title</b></font>
<small>�@�@
|�@�@��$count
</small>
<form method=post action="$bbsurl">
<!--�󔒎Q���Ҏ��ʗp-->
<input type="hidden" name="id" value="$FORM{'id'}">
���O <input type=text name="name" size=20 maxlength=50 value="$FORM{'name'}">
���������N <input type="checkbox" name="auto_link" value="1" checked>
<small>�����O�����ă����[�h����ƎQ���҂Ƃ��ĕ\\������܂�($sessiontime�b��)</small><br>
���e <input type=text name="value" size=80 maxlength=300><br>
���� <input type=submit value="���e /�����[�h"><input type=reset value="del">
<input type=submit name=clean value="������">
<input type=submit name=pclean value="�—���">
<p>
<font size="2" color="#666666">�������̎Q���ҁF$member</font>
_HTML_

	# �L���̏o��
	open(IN,"$bbsfile");
	while (<IN>) {
		chomp($_);
		($date,$name,$value,$cheche) = split(/\t:/,$_);
		if($cheche) {
			print "<hr size=1><font color=\"$namecolor\"><b>$name</b> </font>&gt\; ";
			print "<font color=\"$textcolor\"><b>$value</b></font> <font size=1 color=\"$datecolor\">$date</font>\n";
			print "<input type=radio name=cheche value=$cheche>\n";
		} else {
			print "<hr size=1>$_\n";
		}
	}
	close(IN);

	print <<"_HTML_";
<hr></form><div align=right><small>�����₫���C�g1.1 session <a href="http://mizuiro.virtualave.net/t_lite/">source</a></small>
<a href="./tl11toto.txt">�{�g�C��</a>
</div>
</body></html>
_HTML_
}

sub write{ #-------------------- �������ݏ��� --------------------#
	return if($ENV{'HTTP_REFERER'} !~ /$bbsurl/i);
	if($FORM{'auto_link'}){
		$FORM{'value'} =~ s/(http:\/\/)/\t:$1/g; # �A������URL��\�����ꍇ�̏����i\t:�ŋ�؂�j
		$FORM{'value'} =~ s/http:\/\/([\w|\!\#\$\%\&\'\(\)\=\-\^\`\\\|\@\~\[\{\]\}\;\+\:\*\,\.\?\/]+)/<a href=\"http:\/\/$1\">��<\/a>/g;
		$FORM{'value'} =~ s/\t://g; # \t:�����ɖ߂�
	}

	open(IN,"$bbsfile");
	chomp(@lines=<IN>);
	close(IN);

	splice(@lines,$max-1) if($max <= @lines);

	open(OUT,">$bbsfile");
	print OUT "$date_now\t:$FORM{'name'}\t:$FORM{'value'}\t:$time\n";
	for(@lines){print OUT "$_\n";}
	close(OUT);
}

sub counter{ #-------------------- �A�N�Z�X�J�E���^ --------------------#
	open(IN,"$counterfile");
	$count = <IN>;
	close(IN);
	$count++;
	open(OUT,">$counterfile");
	print OUT "$count";
	close(OUT);
}

sub session{ #-------------------- �Q���ҕ\�� --------------------#

if($FORM{'name'}){
	$addname=$FORM{'id'}=$FORM{'name'};
}
elsif($FORM{'id'}){
	$addname=$FORM{'id'};
}
elsif($ENV{'REQUEST_METHOD'} eq 'POST'){
	$addname=$FORM{'id'}="��$count";
}

open(IN,"$sessionfile");
chomp(@lines=<IN>);
close(IN);

foreach(@lines){ # ���O�ƎQ�����Ԃ��n�b�V���Ɏ�荞��
	($inname,$intime)=split(/\t:/,$_);
	$session{$inname}=$intime;
}

foreach(keys %session){ # �L���������؂�Ă�����폜
	$time - $session{$_} > $sessiontime && delete $session{$_};
}

if($addname){ # ������key����������X�V�A������Βlj�
	$found='';
	foreach(keys %session){
		if($_ eq $addname){
			$session{$_} = $time;
			$found=1;
			last;
		}
	}
	$session{$addname}=$time if(!$found);
}

open(OUT,">$sessionfile");
foreach (sort keys %session){
	print OUT "$_\t:$session{$_}\n";
}
close(OUT);

$member=join(' ',keys %session);

} # session end

# �—�����[����
sub pclean{
	open (IN, "$bbsfile");
	my @data = <IN>;
	close (IN);
	foreach (@data) {
		if ($_ =~ /$FORM{'cheche'}\n/){$_ = "�—�����܂���\n";}
	}
	open (OUT, ">$bbsfile");
	print OUT @data;
	close (OUT);
}

# ��������[����
sub clean {
	open (OUT, ">$bbsfile");
	print OUT "<h1>�S��������܂���</h1>\n";
	close (OUT);
}


sub kinsi{
	@kinsineta = ( '<meta', '.pl','<table', '<plain', '<xmp', '<frame', '.js'); #NG���[�h�ݒ�
	foreach $dmy (@kinsineta){
		&mengo if ($FORM{'name'}  =~ /$dmy/i);
		&mengo if ($FORM{'value'} =~ /$dmy/i);
	}
}

sub mengo{
	print <<"_EOF_";
Content-type: text/html\n\n
���߂�

_EOF_
	exit;
}