ファイル名: w/warewan_bbs.cgi

#!/usr/local/bin/perl

require './jcode.pl';

@wdays = ( "日", "月", "火", "水", "木", "金", "土", "日" );
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);$date = sprintf("%04d/%02d/%02d(%s) %02d:%02d",$year + 1900, $mon + 1, $mday, @wdays[$wday], $hour, $min);

if ($ENV{'REQUEST_METHOD'} eq 'GET')
{
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST')
{
read(STDIN, $form, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $form);
}
else
{
&error("METHOD");
}

foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);

$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/<!--(.|\n)*-->//g;
$value =~ s/\n//g;
$value =~ s/\,//g;
&jcode'convert(*value,'sjis');
$FORM{$name} = $value;
}
if ($FORM{'action'} eq '1'){&tagu;}
elsif ($FORM{'action'} eq '2'){&memo;}
else {&comment;}

#------------------------------------------------------------
sub tagu
{
$Title = 'warewan_bbs';
$BODY = '<BODY BGCOLOR="#000000" TEXT="#C0C0C0">';
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>$Title</TITLE></HEAD>\n";
print "$BODY\n";
print "<blockquote>\n";
print "<BR><BR>\n";
print "<font size = +2><i>BBS_β</i></font>\n";
print " $date<BR><BR>\n";
print "大体のタグは使えると思います。<!--は、使えません。\n";
print "<BR>\n";
print "<ul><li>左右に、隙間も与えていません。空けたいなら、<blockquote>***</blockquote>を使ってください。</li>\n";
print "<BR>\n";
print "<li>画像タグ <IMG SRC=\"http://***.jpg\"></li>\n";
print "<li>リンク <a href=\"http://***.html(jpg)\">コメント</a></li>\n";
print "<li>メール <a href=\"mailto:メールアドレス\">名前</a></li>\n";
print "<li>フォント <font color=\"***\">コメント</font>、デフォルトは、#C0C0C0</li>\n";
print "<li>面倒な、BBSですが、名前、メールアドレス、コメント、その他、適当に何か書けばOK!。</li>\n";
print "<li>初心者ですので、よろしくお願いします。少しずつ改良していきます。</li>\n";
print "</ul></blockquote>\n";
print "<div align=\"center\"><center>\n";
print "<form action=warewan_bbs.cgi method=POST>\n";
print "<input type=hidden name=action value=2>\n";
print "<textarea name=comment rows=8 cols=80></textarea>\n";
print "<BR>\n";
print "<input type=submit value=OK!>\n";
print "</form>\n";
print "</div></center>\n";
print "</BODY>\n";
print "</HTML>\n";
exit;
}
#--------------------------------------------------
sub comment
{
if (!open(IN,"warewan.memo")) { &error("open"); }
@lines = <IN>;
$count = @lines;
close(IN);
$Title = 'warewan_bbs';
print "Content-type: text/html\n\n";
$BODY = '<BODY BGCOLOR="#000000" TEXT="#C0C0C0" LINK="#0000FF" VLINK="#00CC00" ALINK="#FFFF00">';
print "<HTML><HEAD><TITLE>$Title</TITLE></HEAD>\n";
print "$BODY\n";
print "<center>\n";
print "<form action=warewan_bbs.cgi method=POST>\n";
print "<font size = +2><i>BBS_β</i></font>\n";
print " $date \n";
print " タグを使えるシンプルなBBSです。$count件\n";
print "<input type=hidden name=action value=1>\n";
print "<input type=submit value=書きこみページへ>\n";
print "</form>\n";
print "<HR NOSHADE SIZE=3 WIDTH=\"700\" ALIGN=CENTER>\n";
print "</center>\n";
foreach $line (@lines) {
($date,$comment) = split(/,/, $line);
print "<blockquote>\n";
print "$date\n";
print "</blockquote>\n";
print "$comment\n";
print "<HR NOSHADE SIZE=2 WIDTH=\"700\" ALIGN=CENTER>\n";
}
print "</BODY>\n";
print "</HTML>\n";
exit;
}
#-------------------------------------------------------------
sub memo
{
if ($FORM{'comment'} eq "") { &error("comment"); }
$value = "$date,$FORM{'comment'}\n";
if (!open(IN,"warewan.memo")) { &error("open"); }
@lines = <IN>;
$count = @lines;
close(IN);
unshift (@lines,$value);
if ($count >6){
if (!open(OUT,">warewan.memo")) { &error("open"); }
print OUT (@lines[0..3]);
close(OUT);
} else {
if (!open(OUT,">warewan.memo")) { &error("open"); }
print OUT (@lines);
close(OUT);
}
&comment;
}
#------------------------------------------------------------
sub error
{
$Title = 'warewan_bbs';
print "Content-type: text/html\n\n";
$BODY = '<BODY BGCOLOR="#000000" TEXT="#C0C0C0" LINK="#0000FF" VLINK="#00CC00" ALINK="#FFFF00">';
print "<HTML><HEAD><TITLE>$Title</TITLE></HEAD>\n";
print "$BODY\n";
print "<center>\n";
print "<BR><BR><BR>\n";
print "$_[0] エラーです。\n";
print "<BR><BR>\n";
print "<a href=\"warewan_bbs.cgi\">BACK</a>\n";
print "</center>\n";
print "</BODY>\n";
print "</HTML>\n";
exit;
}