<![CDATA[#!/usr/local/bin/perl
# ↑あなたが加入しているプロバイダの｢perl｣言語が使用できる
# パスを指定します。一般的に｢#!/usr/local/bin/perl｣で大丈夫
# 何度トライしてもサーバーエラーが出る場合は「perl5」にしてみる
#=======================================================================================
# CustomBBS Version 98.1
#=======================================================================================
#日本語コード変換モジュール
require './jcode.pl';
#---------------------------------------
#あなたのホームページのアドレス
$homepage = 'http://www.tezukayama.com/index.html';
#---------------------------------------
#メッセージを格納するデータベースファイル
$datafile = 'custom.txt';
#---------------------------------------
#バックグランドの画像ファイル
$bg_gif = '';
#---------------------------------------
#管理者削除モードのパスワード
$password = 'Tnoaz54N';
#---------------------------------------
#掲示板の名前
$title = 'コーヒーを飲みながら BBS COFFE TIME';
#タイトルを掲示板に表示
$titlevew = 'yes';
#タイトル画像
$title_gif = 'http://tezukayama.com/images/cup.gif';
#トップ画像
$top_gif = '';
#---------------------------------------
#バックグランドカラー
$bg_color = '#000000';
#テキストの文字色
$text_color = '#FFFFFF';
#リンク文字色
$link_color = '#FF0000';
#Ｖリンク文字色
$vlink_color = '#FF0000';
#入力フォームの背景色
$form_bg_color = 'しない';
#記事テーブルの背景色
$tb_bg_color = 'なし';
#---------------------------------------
#本文文字の大きさ
$font_size = 3;
#---------------------------------------
#コメント最大記憶数（極端に多くするとパフォーマンスが低下します）
$max = 100;
#---------------------------------------
#1ページに表示する件数
$pagevew = 10;
#---------------------------------------
#クッキーを格納する名前を設定する
$CookieName = 'custombbs';
#---------------------------------------
#ホスト名の表示
$hostvew = '';
#ブラウザの表示
$agentvew = '';
#---------------------------------------
#項目名
$user_name = 'お名前';
$user_email = 'E-Mail';
$email_check = '';
$user_hpaddr = 'HP';
$user_subject = '件名';
#---------------------------------------
#ウィンドウの配置 'left' / 'center'
$window = 'center';
#---------------------------------------
#入力フォームの枠の太さ
$form_border = '0';
#記事テーブルの枠の太さ
$table_border = '3';
#舞閧ﾆ本文のセパレータ
$table_line = '';
#舞閧ﾆ本文のセパレータの背景色
$tb_line_bg_color = 'なし';
#題名の色
$sub_color = '#FFFFBD';
#記事テーブルのサイズ
$table_width = 80;
#---------------------------------------
#管理者メールアドレス
$mailto = 'shinohara@tezukayama.com';
#---------------------------------------
#返信記事を投稿順にする 'yes' / 'no'
#投稿順に設定すると速度が低下する
$rev = 'no';
#---------------------------------------
#タグの許可 'yes' / 'no' / 'member'
$tag_flag = 'no';
#=======================================================================================
# 初期設定が必要なのはここまでです。
#=======================================================================================
$ENV{'TZ'} = "JST-9";
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year += 1900;
$month = sprintf("%02d",$mon + 1);
$mday = sprintf("%02d",$mday);
$hour = sprintf("%02d",$hour);
$min = sprintf("%02d",$min);
#日付時刻のフォーマットを整えます
$youbi = ('日','月','火','水','木','金','土') [$wday];
$date_now = "$year年$month月$mday日($youbi) $hour時$min分";
$softagent = $ENV{'HTTP_USER_AGENT'};
$softagent =~ s/\,/\./g;
$hosei = 1;
if ($softagent =~ /Mozilla\/4/i && $softagent !~ /compatible/i) { $hosei = 0.8; }
$textwidth = 70;
if ($softagent =~ /MSIE\ 3/i) { $textwidth = $textwidth * 1.5; }
$hostaddr = &domain_name;
if ($hostchange eq 'yes' && $hostaddr eq '') { $hostaddr = 'on the Internet'; }
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $QUERY_DATA, $ENV{'CONTENT_LENGTH'});
} else { $QUERY_DATA = $ENV{'QUERY_STRING'}; }
@pairs = split(/&/,$QUERY_DATA);
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/</</g;
$value =~ s/>/>/g;
$value =~ s/\n//g;
$value =~ s/\,/，/g;
&jcode'convert(*value,'sjis');
$QUERY{$name} = $value;
}
if ($window ne 'center') { $table_width = 100; }
if ($tb_bg_color eq 'なし') { $tb_bg_color = ''; }
else { $tb_bg_color = "bgcolor=$tb_bg_color"; }
if ($tb_line_bg_color eq 'なし') { $tb_line_bg_color = $tb_bg_color; }
else { $tb_line_bg_color = "bgcolor=$tb_line_bg_color"; }
&cookie_read;
if (!open(NOTE,"$datafile")) { &error(bad_file); }
@DATA = <NOTE>;
close(NOTE);
#押されたボタンや、呼び出しに対しての分岐
if ($QUERY{'password'} eq $password) { &deletemode; }
elsif ($QUERY{'action'} eq 'comment') { &com_html; }
elsif ($QUERY{'action'} eq 'delete') { &delete; }
elsif ($QUERY{'action'} eq 'regist') { ®ist; }
&html;
exit;
#=======================================================================================
sub html_head {
print "Content-type: text/html\n\n";
print "<html><head><title>" . $title . "</title></head>\n";
print "<body bgcolor=$bg_color text=$text_color link=$link_color vlink=$vlink_color background=$bg_gif>\n";
}
#=======================================================================================
sub comment_form {
if ($window eq 'center') { print "<div align=center><center>\n"; }
if ($top_gif ne '') { print "<img src=$top_gif><br>\n"; }
print "<form name=inputform action=custombbs.cgi method=POST>\n";
print "<input type=hidden name=action value=regist>\n";
print "<input type=hidden name=res value=$QUERY{'res'}>\n";
if ($form_bg_color eq 'しない') { $form_bg_color = ''; }
else { $form_bg_color = "bgcolor=$form_bg_color"; }
print "<table border=$form_border><tr><td $form_bg_color align=center>\n";
if ($titlevew eq 'yes') { print "<font size=5 color=$link_color>$title</font><br>\n"; }
if ($title_gif ne '') { print "<a href=$homepage><img src=$title_gif border=0></a>\n"; }
print "</td><td $form_bg_color>\n";
print "<table border=0>\n";
print "<tr><td align=right>$user_name:</td><td><input type=text size=",35 * $hosei," name=name value=$COOKIE{'name'}></td></tr>\n";
print "<tr><td align=right>$user_email:</td><td><input type=text size=",35 * $hosei," name=email value=$COOKIE{'email'}></td></tr>";
if ($user_hpaddr ne '') { print "<tr><td align=right>$user_hpaddr:</td><td><input type=text size=",48 * $hosei," name=HP value=$COOKIE{'HP'}></td></tr>\n"; }
if ($user_subject ne '') { print "<tr><td align=right>$user_subject:</td><td><input type=text size=",48 * $hosei," name=subject></td></tr>\n"; }
print "</table>\n";
print "</tr></table>\n";
print "</td></tr></table>\n";
print "<textarea name=comment rows=4 cols=$textwidth></textarea><br>";
print "<input type=submit value=書き込み／更新>\n";
print "</form>\n";
if ($window eq 'center') { print "</center></div>\n"; }
}
#=======================================================================================
sub html {
foreach $line (@DATA) {
($date,$code,$re,$name,$email,$HPtitle,$HP,$subject,$comment,$host,$agent) = split(/\,/,$line);
if ($re < 1) { push(@MATCH,$line); }
}
$match = @MATCH;
&html_head;
if ($window eq 'center') { print "<div align=center><center>\n"; }
&comment_form;
&listvew;
print "<form method=POST action=custombbs.cgi>\n";
print "<input type=hidden name=action value=delmode>\n";
print "<input type=password size=20 name=password>\n";
print " <input type=submit value=管理者メンテナンス>\n";
print "</form>\n";
if ($window eq 'center') { print "</center></div>\n"; }
print "<p align=right><font size=2><a href=http://www2q.meshnet.or.jp/~terra/cgi/>CustomBBS by Terra</a></font></p>\n";
print "</body></html>\n";
exit;
}
#=======================================================================================
sub com_html {
foreach $line (@DATA) {
($date,$code,$re,$name,$email,$HP,$subject,$comment) = split(/\,/,$line);
if ($code == $QUERY{'res'}) { push(@MATCH,$line); last; }
}
&html_head;
&comment_form;
print "<div align=center><center>\n";
print "<p><font size=5><b>この記事への返信です。</b></p>\n";
&listvew;
print "</center></div>\n";
print "</body></html>\n";
exit;
}
#=======================================================================================
sub cookie_regist {
$ENV{'TZ'} = "GMT";
($c_sec,$c_min,$c_hour,$c_mday,$c_mon,$c_year,$c_wday,$c_yday,$c_isdst) = localtime(time + 30 * 86400);
$c_year += 1900;
$c_sec = sprintf("%02d",$c_sec);
$c_min = sprintf("%02d",$c_min);
$c_hour = sprintf("%02d",$c_hour);
$c_mday = sprintf("%02d",$c_mday);
$youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday') [$c_wday];
$month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec') [$c_mon];
$date_gmt = "$youbi, $c_mday\-$month\-$c_year $c_hour:$c_min:$c_sec GMT";
$cook = "name\!$QUERY{'name'}\,email\!$QUERY{'email'}\,HP\!$QUERY{'HP'}";
print "Set-Cookie: $CookieName=$cook; expires=$date_gmt\n";
$COOKIE{'name'} = $QUERY{'name'}; $COOKIE{'email'} = $QUERY{'email'}; $COOKIE{'HP'} = $QUERY{'HP'};
}
#=======================================================================================
sub cookie_read {
$cookies = $ENV{'HTTP_COOKIE'};
@pairs = split(/;/,$cookies);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$name =~ s/ //g;
$DUMMY{$name} = $value;
}
@pairs = split(/,/,$DUMMY{$CookieName});
foreach $pair (@pairs) {
($name, $value) = split(/\!/, $pair);
$COOKIE{$name} = $value;
}
}
#=======================================================================================
sub listvew {
if ($rev eq 'yes') { @DATA = reverse(@DATA); }
if ($QUERY{'pline'} eq '') { $pline = 0; } else { $pline = $QUERY{'pline'}; }
$end_data = @MATCH - 1;
$page_end = $pline + ($pagevew - 1);
if ($page_end >= $end_data) { $page_end = $end_data; }
if ($table_border == 0) { print "<hr width=$table_width%>\n"; }
foreach ($pline .. $page_end) {
($date,$code,$res,$name,$email,$HP,$subject,$comment,$host,$agent) = split(/\,/,$MATCH[$_]);
$comment = &inline_link($comment);
$comment =~ s/\r/<br>/g;
print "<form method=POST action=custombbs.cgi>\n";
print "<input type=hidden name=action value=comment>\n";
print "<input type=hidden name=res value=$code>\n";
print "<input type=hidden name=mailto value=$email>\n";
print "<table border=$table_border cellspacing=2 width=$table_width%>\n";
if ($table_line eq 'yes') { print "<tr><td $tb_line_bg_color>\n"; }
else { print "<tr><td $tb_bg_color>\n"; }
print "<font size=4 color=$sub_color><b>$subject</b>\n";
if ($email ne '') { print " <a href=mailto:" . $email . ">" . $name . "</a>\n"; }
else { print " $name\n"; }
print "</font> さん\n";
if ($HP ne '') { print " <a href=$HP target=_top>HomePage</a>"; }
print "<font size=-1> $date";
if ($hostvew eq 'yes' && $agentvew ne 'yes') { print " ($host)"; }
print "</font>\n";
if ($QUERY{'action'} ne 'comment') { print " <input type=submit value=返信>"; }
if ($agentvew eq 'yes') {
print "<br><font size=2>";
if ($hostvew eq 'yes') { print " ($host)"; }
print " $agent</font>";
}
if ($table_line eq 'yes') { print "</td></tr><td $tb_bg_color>\n"; }
print "<blockquote>\n";
print "<p><font size=$font_size>$comment</font></p>\n";
$i = 1;
foreach $line (@DATA) {
($da,$co,$re,$na,$em,$H,$su,$com,$ho,$ag) = split(/\,/,$line);
if ($rev eq 'no' && $co <= $code) { last; }
if ($code eq $re) {
$com =~ s/\r/<br>/g;
if ($i == 1) {
$ulflag = 1;
print "<hr>";
print "<ul>\n";
} else { print "<hr>\n"; }
$com = &inline_link($com);
print "<li>\n";
#メールアドレスが記入されていればリンクをつける
if ($em ne '') { print "<b><a href=mailto:" . $em . ">" . $na . "</a></b>\n"; }
else { print "<b>" . $na . "</b>\n"; }
print "</font> さん\n";
if ($H ne '') { print " <a href=$H>HomePage</a>\n"; }
print "<font size=2> 投稿日：$da";
if ($hostvew eq 'yes' && $agentvew ne 'yes') { print " ($ho)"; }
if ($agentvew eq 'yes') {
print "<br>";
if ($hostvew eq 'yes') { print " ($ho)"; }
print " $ag";
}
print "</font><br> <br>\n";
print "<font size=$font_size>$com</font></li>\n";
$i++;
}
}
if ($ulflag == 1) { print "</ul>\n"; }
print "</blockquote>\n";
print "</td></tr></table></form><p>\n";
if ($table_border == 0) { print "<hr width=$table_width%>\n"; }
}
$next_line = $page_end + 1;
if ($page_end ne $end_data) {
print "<form method=POST action=custombbs.cgi>\n";
print "<input type=hidden name=action value=$QUERY{'action'}>\n";
print "<input type=hidden name=key value=$QUERY{'key'}>\n";
print "<input type=hidden name=pline value=" . $next_line . ">\n";
print "<input type=submit value=次のページ>\n";
print "</form>\n";
print "<hr width=640>\n";
}
}
#=======================================================================================
sub regist {
if ($QUERY{'comment'} ne '') {
if ($QUERY{'name'} eq '') { &error(bad_name); }
if ($email_check eq 'yes' && $QUERY{'email'} eq '') { &error(bad_email); }
&cookie_regist;
$match = 0;
if ($tag_flag eq 'yes') { $match = 1;
} elsif ($tag_flag eq 'member') {
foreach $line (@TAG_MENBER) {
if ($line eq $QUERY{'name'}) { $match = 1; last; }
}
}
if ($match) { $QUERY{'comment'} = &tag_change($QUERY{'comment'}); }
$count = @DATA;
if ($count >= $max) { pop(@DATA); }
if ($count < 1) {
$new_code = 1;
} else {
($date,$code,$re,$name,$email,$HP,$subject,$comment,$host,$agent) = split(/\,/,$DATA[0]);
$new_code = $code + 1;
}
$value = "$date_now\,$new_code\,$QUERY{'res'}\,$QUERY{'name'}\,$QUERY{'email'}\,$QUERY{'HP'}\,$QUERY{'subject'}\,$QUERY{'comment'}\,$hostaddr\,$softagent\n";
unshift(@DATA,$value);
if (!open(NOTE,">$datafile")) { &error(bad_file); }
print NOTE @DATA;
close(NOTE);
}
$QUERY{'res'} = '';
}
#=======================================================================================
sub deletemode {
$count = @DATA;
if ($count < 1) { &html; }
&html_head;
print "<form action=custombbs.cgi method=POST>\n";
print "<input type=hidden name=action value=delete>\n";
print "削除コード：<input type=text size=39 name=delcode>\n";
print " <input type=submit value=削除><br>\n";
print "<font size=2>スペースで区切っていくつでも同時に削除することができます。</font>\n";
print "</form>\n";
print "<hr>\n";
foreach $line (@DATA) {
($date,$code,$re,$name,$email,$HP,$subject,$comment,$host,$agent) = split(/\,/,$line);
print "<table border=0 width=100%>\n";
print "<tr>\n";
print "<td width=5% valign=top>[$code]</td>\n";
print "<td valign=top>\n";
print "<font color=$link_color size=+1><b>$subject</b></font>\n";
print " 投稿者：\n";
if ($email ne '') { print "<b><a href=mailto:" . $email . ">" . $name . "</a></b>\n"; }
else { print "<b>" . $name . "</b>\n"; }
print "<font size=-1> 投稿日：" . $date . "</font><br>\n";
print "$comment\n";
print "</td>\n";
print "</tr></table>\n";
print "<hr>\n";
}
print "<form action=custombbs.cgi method=POST>\n";
print "<input type=hidden name=action value=delete>\n";
print "削除コード：<input type=text size=39 name=delcode>\n";
print " <input type=submit value=削除><br>\n";
print "<font size=2>スペースで区切っていくつでも同時に削除することができます。</font>\n";
print "</form>\n";
exit;
}
#=======================================================================================
sub delete {
$QUERY{'delcode'} =~ s/ / /g;
@CODE = split(/ /,$QUERY{'delcode'});
$keycount = @CODE;
#削除する番号が指定されていなければ戻る
if ($keycount < 1) { &html; }
foreach $line (@DATA) {
($date,$code,$re,$name,$email,$HP,$subject,$comment,$host,$agent) = split(/\,/,$line);
$match = 0;
foreach $delcode (@CODE) {
if ($delcode > 0) {
if ($code == $delcode || $re == $delcode) { $match = 1; }
}
}
if ($match == 0) { push (@DUMMY,$line); }
}
@DATA = @DUMMY;
#データベースファイルを上書きする
if (!open(DB,">$datafile")) { &error(bad_file); }
print DB @DATA;
close(DB);
}
#=======================================================================================
sub domain_name {
local($addr) = $ENV{'REMOTE_ADDR'};
local($_) = gethostbyaddr(pack("C4",split(/\./,$addr)),2);
if ($_ eq '') { $_ = $addr; }
$_;
}
#=======================================================================================
sub inline_link {
local($_) = $_[0];
$_ =~ s/([^=^\"]|^)((http|ftp):[!#-9A-~]+)/$1<a href=$2 target=_top>ここを押して<\/a>/g;
$_ =~ s/([!#-9A-~\-\_]+\@[!#-9A-~\-\_\.]+)/<a href=mailto:$1>$1<\/a>/g;
$_;
}
#=======================================================================================
sub tag_change {
local($_) = $_[0];
1 while s/(.*)(<(img([!-:A-~\s\=]+))>)/$1<img$4>/i;
1 while s/(.*)(<(font[\s\w\=\#\"\']+)\>(.*)\<\/font\>)/$1<$3>$4<\/font>/i;
1 while s/(.*)(<(b)>(.*)<\/b>)/$1<b>$4<\/b>/i;
1 while s/(.*)(<(i)>(.*)<\/i>)/$1<i>$4<\/i>/i;
$_;
}
#=======================================================================================
sub error {
$error = $_[0];
if ($error eq 'bad_file') { $msg = 'ファイルのオープン、入出力に失敗しました。'; }
elsif ($error eq 'bad_name') { $msg = 'ニックネームが記入されていません。'; }
elsif ($error eq 'bad_comment') { $msg = 'コメントが記入されていません。'; }
elsif ($error eq 'bad_email') { $msg = 'メールアドレスが不正です。'; }
elsif ($error eq 'bad_pass') { $msg = 'パスワードが一致しません。'; }
elsif ($error eq 'send_mail') { $msg = 'sendmailをオープンできません。'; }
else { $msg = '原因不明のエラーで処理を継続できません。'; }
&html_head;
print "<p> </p><p> </p><p> </p><center><font size=6><b>ＥＲＲＯＲ</b></font><p> </p><p> </p>\n";
print "<table border=5 width =70%><tr>\n";
print "<td align=center><center><p> </p><p> </p>\n";
print "<font size=6><b><i>$msg</i></b></font><p> </p><p> </p></td>\n";
print "</tr></table>\n";
print "</center></body></html>\n";
exit;
}
]]>