blue-oceans/board-t/board.cgi

#!/usr/bin/perl
## This file is euc-jisx0213 encoding.

use Suika::CGI;
$myvesion = '1.00 (2001-08-22)';

$about_perl = <<"EOH";
<address class="version" style="font-size: 50%">
FlasH BBS Pro v1.41 [�<a href="http://www7.big.or.jp/~jawa/">Shigeto Nakazawa</a>] をベースに<a href="http://www.ne.jp/asahi/minazuki/bakera/">水無月ばけら</a>が改造
+ <a href="mailto:wakaba\@suika.fam.cx">若葉</a>の quick hack $myversion
</address>
EOH

## h12-05-06    水無月ばけら <bakera@star.email.ne.jp>
## h09-01-17    じゃわ@中澤重人 <jawa@big.or.jp>
##              FlasH BBS Pro 1.41 <http://www7.big.or.jp/~jawa/>

#一般設定
$max_size = 512 * 1024;
$max_msg = 2000;
$admin_email = 'blue-oceans@suika.fam.cx';
$this_name = 'board';
$gif_allnews = '';
$gif_news = '';
$gif_new_news = '';
$gif_width = 20;
$gif_height = 14;
$default_title = '題名を入れて下さい';
$default_name = 'お名前をどうぞ';
$default_email = '電子メイルアドレスをどうぞ。(省略可能)';
$default_comment = '本文をどうぞ';
$arc_dir = './log/';
$log_dir = './log/';
$base_url = "http://suika.fam.cx/~okuchuu/blue-oceans/";
$rfc_base_uri = 'http://dnsbalance.ring.gr.jp/pub/doc/RFC';
$logfile = $log_dir.'bo.log';

#ロックファイル検出時のリトライ回数
$retry = 3;

#文字コード
$mojicode = "euc";

#NN2 で charset=EUC-JP を送ると化けるらしい。
if( $ENV{'HTTP_USER_AGENT'} =~ /compatible/ ){
        $charset = ';charset=EUC-JP';
}elsif( $ENV{'HTTP_USER_AGENT'} =~ /Mozilla\/2.0/ ){
        $charset = '';
}else{
        $charset = ';charset=EUC-JP';
}

&read_form;

#パラメータの処理
#デフォルト
$uri_mode = 'all';
$tree = 0;
$new_kiji = 10;
$max_tree = 10;
$nazo = '';
$indent = 'ul';
$max_depth = 40;
$margin = 3;

$ID = $OPT{'id'};
$uri_query = "id=$ID";
$form_query = "<input type=\"hidden\" name=\"id\" value=\"$ID\">";
if($OPT{'link'}){
        $uri_mode = $OPT{'link'};
        &add_query('link', $uri_mode);
}
if($OPT{'tree'}){
        $tree = $OPT{'tree'};
        &add_query('tree', $tree);
}
if($OPT{'new_kiji'}){
        $new_kiji = $OPT{'new_kiji'};
        &add_query('new_kiji', $new_kiji);
}
if($OPT{'tmp_new_kiji'}){
        $new_kiji = $OPT{'tmp_new_kiji'};
        #このパラメータはクエリーに反映しない。
}
if($OPT{'max_tree'}){
        $max_tree = $OPT{'max_tree'};
        &add_query('max_tree',$max_tree);
}
if($OPT{'nazo'}){
        $nazo = $OPT{'nazo'};
        &add_query('nazo', $nazo) if ( $nazo ne 'only' );
}
if($OPT{'indent'}){
        $indent = $OPT{'indent'};
        &add_query('indent', $indent);
}
if($OPT{'max_depth'}){
        $max_depth = $OPT{'max_depth'};
        &add_query('max_depth', $max_depth);
}
if($OPT{'margin'}){
        $margin = $OPT{'margin'};
        &add_query('margin', $margin);
}

        $cookie_name = 'board';
        $title = 'ブルーオーシャンズ掲示板';
        $backurl = '../top';
        $back_name = '目次';
        $html_info = '';
        $link_element = '';
        ## Administrator
        $address_element = "<address><a href=\"mailto:blue-oceans\@suika.fam.cx\">ブルーオーシャンズ</a></address>";

  
$defhead = <<"EOH";

<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja">
<head>
<title>$title</title>
<link rel="stylesheet" href="/s/simpledoc">
<link rel="stylesheet" href="../bo-style">
<link rel="index" href="../top" />
</head>
<body>
<h1>$title</h1>
EOH
$def_header_http = <<EOH;
Content-Type: text/html; charset=euc-jisx0213
Content-Language: ja
Content-Style-Type: text/css
Content-Script-Type: text/javascript

EOH

$deffoot = <<"EOH";
$address_element
$about_perl
</body></html>
EOH

$navi_usage = '<div class="navi"><p>[';
$navi_ichiran = "<a href=\"$this_name?$uri_query\">一覧表示</a>";
$navi_num = " / <a href=\"$this_name?$uri_query;md=num\">最新記事</a>";
$navi_new = " / <a href=\"$this_name?$uri_query;md=new\">新規投稿</a>";
$navi_back = " / <a href=\"$backurl\">$back_name</a> ]</p></div>";
$html_navi = "<p class=\"navi\">$navi_usage$navi_ichiran$navi_num$navi_new$navi_back</p>";


## 

&get_cookie;
if      ($nazo eq 'only')       {&nazo_only;    }
elsif   ($OPT{'md'} eq 'reg')   {&regist;       }
elsif   ($OPT{'md'} eq 'del')   {&delete;       }
elsif   ($OPT{'md'} eq 'viw')   {&view; }
elsif   ($OPT{'md'} eq 'new')   {
  $html_navi = "<p class=\"navi\">$navi_usage$navi_ichiran$navi_num$navi_back";
  &html_form('root');
}
elsif ($OPT{'md'} eq 'set') { &set; }
elsif ($OPT{'md'} eq 'num') {
        $html_navi = "<p class=\"navi\">$navi_usage$navi_ichiran$navi_new$navi_back";
        &number;
}
else {
        $html_navi = "<p class=\"navi\">$navi_usage$navi_num$navi_new$navi_back";
        &ichiran;
}
&html_footer;
exit 0;

# [ ヘッダー部分表示 ]
#

sub html_header {
  my($sub_title) = @_;
  my $s;
if ($sub_title) {
  $s = <<"_EOF_";
Content-Type: text/html; charset=euc-jisx0213
Content-Language: ja
Content-Style-Type: text/css
Content-Script-Type: text/javascript

<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html lang="ja">
<head>
<link rel="stylesheet" href="/s/simpledoc">
<link rel="stylesheet" href="../bo-style">
$link_element
<title>$title ($sub_title)</title>
_EOF_

        if($indent eq 'css'){
                my($i, $tmp_margin);
                $s .= '<style type="text/css">';
                for( $i = 1; $i <= $max_depth; $i++ ){
                        $tmp_margin = $margin * $i;
                        print ".lv$i\{margin-left:$tmp_margin\%\}";
                }
                $s .= '</style>';
        }
        $s .= <<"_EOF_";
</head>
<body>
<h1><a name="top">$title</a></h1>
$html_navi
<h2>$sub_title</h2>
_EOF_
  return $s;
}
  print $s;
}

sub html_footer {
        print<<"_EOF_";
$deffoot
_EOF_
}

# [ 一覧表示 ]
#

sub ichiran {
        &set_cookie;
        local($s) = &html_header('記事一覧');

        #ログ読み出し
        open(LOG, $logfile) or &Suika::CGI::Error::die('open', file => $logfile);
        print $s;
        my($count, $last_nj);
        $count = <LOG>;chop($count);
        $last_nj = <LOG>;chop($last_nj);

        if( $indent eq 'css' ||  $indent eq 'ul' ){
                $prt_elm = 'ul';
                $cld_elm = 'li';
        }else{
                $prt_elm = 'div';
                $cld_elm = 'p';
        }

        print $html_info;
        print '<div class="set">';
        print "<p><em class=\"note\">([全]を選択すると関連記事も含めて一括表示できます。)</em></p>\n";
        $tree = int($tree/$max_tree) * $max_tree;
        $end_tree = $tree + $max_tree;
        my($tree_count) = 0;
        while (<LOG>) {
                my($last_lx) = -1;
                $tree_count++;
                next if $tree_count <= $tree;
                next if $tree_count > $end_tree;
                print "\n<hr>\n<$prt_elm class=\"tree\">";
                @datas = &divide_log($_);
                foreach (@datas) {
                        my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($_);
                        if ( $indent eq 'ul' && $last_lx > -1 ){
                                my($l_diff) =  $last_lx - $lx;
                                if( $l_diff < 0 ){
                                        print "<$prt_elm>";
                                }elsif( $l_diff > 0){
                                        my($i);
                                        print "</$cld_elm>";
                                        for($i = 1; $i <= $l_diff; $i++){
                                                print "</$prt_elm></$cld_elm>";
                                        }
                                }else{
                                        print "</$cld_elm>";
                                }
                        }
                        if($indent eq 'css'){
                                print "<$cld_elm class=\"lv$lx\">";
                        }else{
                                print "<$cld_elm>";
                        }
                        if ($res eq 'root') {
                                print "[<a href=\"$this_name?$uri_query;md=set;tn=$tn\">全</a>]";
                        } elsif ($indent eq 'space') {
                                my($space_width) = $lx * 2 + 2;
                                print '&nbsp;' x $space_width;
                        }
                        print "<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$tn\">";
                        if ($no > $count - $new_kiji) {
                                print "[新]";
                        } else {
                                print "[・]";
                        }
                        print " $title</a> : ";
                        if ($COOKIE{'name'} eq $name) {
                                print "<strong>$name</strong>"; #自分の記事を強調表示
                        } else {
                                print $name;
                        }
                        print " <span class=\"date\">($date)</span>";
                        $last_lx = $lx;
                }
                if ( $indent eq 'ul' ){
#                       print "<!--$last_lx-->";
                        my($i);
                        for($i = 1; $i <= $last_lx; $i++){
                                print "</$cld_elm></$prt_elm>";
                        }
                }
                print "</$cld_elm></$prt_elm>";
        }
        close(LOG);
        print"</div>\n";

        &navi_form($tree_count);
}

# [ 個別で記事の内容を表示する ]
#

sub view {
  local($s) = $def_header_http.$defhead.$html_navi."<h2>記事$OPT{'no'}</h2>";
  my(@kiji_datas) = &divide_log(&search_tree);
  my($kiji_data) = &search_data(@kiji_datas);
  
  $s .= &kiji_view($kiji_data);
  $s .= "<div class=\"comment-navi\">";
        my($no,$rq_res,$lx,$tn,$title,$name,$email,$date,$rq_act,$file_pwd,$rhost,$ipad,$comment) = &divide_data($kiji_data);
        foreach (@kiji_datas) {
                my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($_);
                if ($rq_res == $no) {
                        $parent = "この記事は「<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">$title</a>」へのコメントです。";
                }
                if (($res == $OPT{'no'}) && ($res ne 'root')) {
                        $children .= "<li>「<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">$title</a>」$name<span class=\"date\">($date)</span></li>";
                }
        }
        if ($rq_res eq 'root') { $parent = 'ルート記事です。'; }
        elsif (!$parent) { $parent = '元になった記事はみつかりませんでした。'; }
        if (!$children) { $children = 'コメントは投稿されていません。</p>'; }
        else{$children = "以下のコメントが投稿されています。</p>\n<ul class=\"comment\">$children</ul>";}
        $s .= <<"_EOF_";
<hr>
<p>$parent
$children
<hr></div>
_EOF_
        if ($rq_act > 6) {
                $s .= '<p>この記事に対してコメントを投稿することは出来ません。</p>';
                return 0;
        }elsif( $nazo eq 'no' ){
                $s .= '<!--謎スケルチモードではコメントの投稿は出来ません。-->';
                return 0;
        }
  if    ($title =~ /^[Rr][Ee]\^\d+\:(.*)/)      {$title = "Re: $1";}
  elsif ($title =~ /^[Rr][Ee]\[\d+\]\:(.*)/)    {$title = "Re: $1";}
  elsif ($title =~ /^[Rr][Ee]\:(.*)/)   {$title = "Re: $1";}
  else  {$title = "Re: $title"; }
        $comment = "<br>$comment";
        $comment =~ s/<br>((&gt;)+)/\n$1&gt;/ig;
        $comment =~ s/<br>/\n&gt; /ig;
        $comment =~ s/\n//;
        $s .= '<p>この記事に関するコメントを投稿する場合は以下の投稿欄に書き込んで下さい。</p>';
        $s .= &html_form($OPT{'no'},$title,$comment,$OPT{'tn'},$lx,1);

        #投稿者削除
        if (crypt($COOKIE{'pwd'},$file_pwd) eq $file_pwd) {
                $s .= <<"_EOF_";
<hr>
<form action="./$this_name" method="post">
<p>
$form_query
<input type="hidden" name="md" value="del">
<input type="hidden" name="code" value="$OPT{'code'}">
<input type="hidden" name="tn" value="$OPT{'tn'}">
<input type="hidden" name="no" value="$OPT{'no'}">
<input type="hidden" name="pwd" value="$COOKIE{'bbs_pwd'}">
<input type="submit" value="この記事の内容を削除する">
<em class="note">(完全に削除出来ない場合もあります。)</em></p>
</form>
_EOF_
        }
 
  print ($s.$deffoot);
  exit;
}

# [ セット表示 ]
#

sub set {
        my($last_lx) = -1;
        print &html_header('セット表示');
        
        if( $indent eq 'css' || $indent eq 'ul' ){
                $prt_elm = 'ul';
                $cld_elm = 'li';
        }else{
                $prt_elm = 'div';
                $cld_elm = 'p';
        }

        print<<"_EOF_";
<div class=\"set\">
<h3><a name="list">記事一覧</a></h3>
<$prt_elm class="tree">
_EOF_
        @kiji_datas = &divide_log(&search_tree);
        foreach (@kiji_datas) {
                my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($_);
                my($num_no) = int($no);
                $reply[$res] .= "$num_no-";
                if ( $indent eq 'ul' && $last_lx > -1 ){
                        my($l_diff) =  $last_lx - $lx;
                        if( $l_diff < 0 ){
                                print "<$prt_elm>";
                        }elsif( $l_diff > 0){
                                my($i);
                                print "</$cld_elm>";
                                for($i = 1; $i <= $l_diff; $i++){
                                        print "</$prt_elm></$cld_elm>";
                                }
                        }else{
                                print "</$cld_elm>";
                        }
                }
                if($indent eq 'css'){
                        print "<$cld_elm class=\"lv$lx\">";
                }else{
                        print "<$cld_elm>";
                }
                $last_lx = $lx;
                if ($res ne 'root' && $indent eq 'space') {
                        my($space_width) = $lx * 2 + 2;
                        print '　' x $space_width;
                }
                print "<a href=\"#c$num_no\">・ $title</a> : $name <span class=\"date\">($date)</span>";
                print "</$cld_elm>\n" unless ($indent eq 'ul');
        }
        if ( $indent eq 'ul' ){
#               print "<!--$last_lx-->";
                my($i);
                for($i = 1; $i <= $last_lx; $i++){
                        print "</$cld_elm></$prt_elm>";
                }
        }else{
                print "</$prt_elm>";
        }

        print"</$cld_elm></$prt_elm></div>\n";

        foreach $data (@kiji_datas) {
                my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
                my($num_no) = int($no);

                print "<p>No.<a name=\"c$num_no\">$num_no</a>";
                if ($res eq 'root') {
                        print '<em class="note">(親記事)</em>';
                } else {
                        $res = int($res);
                        print "<a href=\"#c$res\">▲<em>[$res]</em></a>";
                }
                if (!$reply[$no]) {
                        print ' / <em class="note">(注釈なし)</em>';
                } else {
                        chop($reply[$no]);
                        my(@replys) = split(/-/,$reply[$no]);
                        foreach (@replys) {
                                print " / <a href=\"#c$_\">▼<em>[$_]</em></a>";
                        }
                }
                print "</p>\n";

                print &kiji_view($data);
                if( $nazo eq 'no' ){
                        print '<!--謎スケルチモードではコメントの投稿は出来ません。-->';
                }else{
                        print "<p><a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">コメントを投稿</a> / ";
                }
                print "<a href=\"#list\">記事一覧</a></p><hr>";
        }
}

# [ 最新記事一括機能 ]

sub number {
        print &html_header("最新記事");
        print "<p>最近の記事 $new_kiji 件を表示しています。</p>";
        print '<p>[';
        my($i,$j,$tmp);
        for ( $i = 1; $i <= 10; $i++ ){
                $j = $i * 10;
                unless ($new_kiji == $j){
                        if($tmp){
                                print ' / ' ;
                        }else{
                                $tmp = 1;
                        }
                        print "<a href=\"$this_name?$uri_query;md=num;tmp_new_kiji=$j\">$j 件</a>";
                }
        }
        print ' ]</p>';
        open(LOG,$logfile) or  &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
        my($count, $last_nj);
        $count = <LOG>;chop($count);
        $last_nj = <LOG>;chop($last_nj);
        while (<LOG>) {
                @datas = &divide_log($_);
                foreach $data (@datas) {
                        my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($data);
                        if ($no > $count - $new_kiji) {
                                push(@nums,$data);
                        }
                }
                last if @nums >= $new_kiji;
        }
        close(LOG);

        @nums = reverse(sort(@nums));
        print '<ul class="new">';
        my($list_order);
        foreach $data (@nums) {
                my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
                $list_order++;
                print "<li><p>$list_order: 記事No.$no</p>\n";
                print &kiji_view($data);
                print<<"_EOF_";
<p><a href="$this_name?$uri_query;md=viw;no=$no;tn=$tn">コメントを投稿</a> / <a href="$this_name?$uri_query;md=set;tn=$tn">セットで表示</a></p><hr></li>
_EOF_
        }
        print '</ul>';
}

# [ 投稿フォームを表示 ]
#

sub html_form {
  my($no,$title,$comment,$tn,$lx,$c) = (@_);
  local($s); $s = $def_header_http.$defhead if $c != 1;
  $s .= '<h2>記事の投稿</h2>';
  
        if ($no eq '') { $no = 'root'; }
        $title = "($default_title)" unless $title;
        $comment = "($default_comment)" unless $comment;
        if($COOKIE{'name'}){
                $my_name = $COOKIE{'name'};
        }else{
                $my_name = "($default_name)";
        }
        if($COOKIE{'email'}){
                $my_email = $COOKIE{'email'};
        }else{
                $my_email = "($default_email)";
        }
        
        $nj = time() . '-' . &random_string(8);

  $s .= <<"_EOF_";
<script type="text/javascript" defer="defer"><!--
function check(myform){
 if(!myform.name.value ){
  alert("投稿者名を記入してください。");
  myform.name.focus();
  return false;
 } else if(!myform.title.value ){
  alert("題名を記入してください。");
  myform.title.focus();
  return false;
 } else if(!myform.comment.value ){
  alert("本文を記入してください。");
  myform.comment.focus();
  return false;
 } else {
  return true;
 }
}
//--></script>
<form action="./$this_name" method="post" onsubmit="return check(this);">
<p><label accesskey="S" for="title">題名(<span class="key">S</span>):</label>
<input type="text" name="title" id="title" size="40" maxlength="80" value="$title"></p>
<p><label accesskey="N" for="name">名前(<span class="key">N</span>):</label>
<input type="text" name="name" id="name" size="40" maxlength="42" value="$my_name"></p>
<p><label accesskey="E" for="email">メイル(<span class="key">M</span>):</label>
<input type="text" name="email" id="email" size="60" maxlength="120" value="$my_email"></p>
<p><label accesskey="B" for="comment">本文(<span class="key">B</span>):</label>
<br><textarea name="comment" id="comment" rows="10" cols="70">$comment</textarea></label></p>
<p><input type="submit" value="送信">
$form_query
<input type="hidden" name="md" value="reg"><input type="hidden" name="no" value="$no"><input type="hidden" name="tn" value="$tn"><input type="hidden" name="lx" value="$lx"><input type="hidden" name="pwd" value="$COOKIE{'pwd'}"><input type="hidden" name="nj" value="$nj"><input type="hidden" name="code" value="$OPT{'code'}"></p>
</form>
_EOF_
  if ($c == 1) {
   $s;
  } else {
   print ($s);
  }
}

# [ 記事内容を表示 ]

sub kiji_view {
        my($data) = @_;
        my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$tm_pwd,$rhost,$ipad,$comment) = &divide_data($data);
#       &jcode'convert(*comment,'euc');
        $comment = &squelch($comment) if $nazo;
        $comment =~ s/(<br>|\s|　)+$//g;
        $comment =~ s/^(>|&gt;)([^<]*)/<q class=\"responce\">&gt;$2<\/q>/g;
        $comment =~ s/<br>(>|&gt;)([^<]*)/<br><q class=\"responce\">&gt;$2<\/q>/g;

#URL にアンカーを設定する
        if( $uri_mode eq 'uri' || $uri_mode eq 'all' ){
                $comment =~ s/(https?|ftp|gopher|telnet|nntp|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/<a href=\"$1\:$2\">$1\:$2<\/a>/ig;
        }
        if( $uri_mode eq 'rfc' || $uri_mode eq 'all' ){
                $comment =~ s/(\W)([Rr][Ff][Cc]\s?)([1-9]\d*)(\W)/$1<a href=\"$rfc_base_uri\/rfc$3.txt\">$2$3<\/a>$4/g;
        }
#       &jcode'convert(*comment,$mojicode);
        if ($email) { $name = "<a href=\"mailto:$email\">$name</a>"; }
        local($s) = <<"_EOF_";
<!-- message start -->
<div class="message"><h3 class="subject">$title</h3>
<div class="message-header"><p><cite class="from">$name</cite>
<span class="date">($date)</span><!--$rhost($ipad)--></p></div>
<div class="message-body">
<p>$comment</p></div></div>
<!-- message end -->
_EOF_
  $s;
}

# [ 記事登録処理 ]

sub regist {
        my($title,$name,$email,$comment,$lx,$tn,$pwd,$ref_url) = ($OPT{'title'},$OPT{'name'},$OPT{'email'},$OPT{'comment'},$OPT{'lx'},$OPT{'tn'},$OPT{'pwd'},$ENV{'HTTP_REFERER'});
        $title =~ s/^\($default_title\)//;
        $title =~ s/\r\n//g;
        $title =~ s/[\r\n]//g;
        $name  =~ s/^\($default_name\)//;
        $name  =~ s/\r\n//g;
        $name  =~ s/[\r\n]//g;
        $email =~ s/^\($default_email\)//;
        $email =~ s/\r\n//g;
        $email =~ s/[\r\n]//g;
        $comment =~ s/^\($default_comment\)//;
        $comment =~ s/^\s+//g;
        $comment =~ s/(\s|　)+$//g;
        $comment =~ s/\r\n/<br>/g;
        $comment =~ s/[\r\n]/<br>/g;
        $lx++;
        $pwd =~ s/\r\n//g;
        $pwd =~ s/\r|\n//g;
        $ref_url =~ s/\?(.|\n)*//g;
        s/\%7E/\~/g;

#投稿チェック
        if($ENV{'REQUEST_METHOD'} ne "POST"){
                &method_error();
#       }elsif($base_url && ($ref_url !~ $base_url)){
#               &error('不正投稿','アクセスは受け入れられませんでした。外部からの不正な投稿が行われた可能性があります。正しい投稿でもこのエラーが出る場合は、ブラウザが Referer を送出する設定になっているか確認してください。');
        }elsif (length($title) > 80) {
                $_ = length($title) - 80;
                &error('題名入力エラー',"題名が長すぎます。$_ バイト削減してください。");
        }elsif (!$title) {
                &error('題名入力エラー','題名が入力されていません。');
        }elsif (!$name) {
                &error('投稿者名入力エラー','投稿者名が入力されていません。');
        }elsif (length($name) > 42) {
                $_ = length($name) - 42;
                &error('投稿者名入力エラー',"投稿者名が長すぎます。$_ バイト削減してください。");
        }elsif ($email && $email !~ /\w[\w\.\-]*\@\w[\w\.\-]*\.\w+/){
                &error('メールアドレス入力エラー','メールアドレスの書式が不正です。全角文字を使っていないか、空白を含めていないか確認してください。');
        }elsif (length($email) > 120) {
                $_ = length($email) - 120;
                &error('メールアドレス入力エラー',"メールアドレスが長すぎます。$_ バイト削減してください。");
        }elsif (!$comment) {
                &error('本文入力エラー','本文が入力されていません。空白のみの投稿は出来ません。');
        }elsif (length($comment) > $max_msg) {
                $_ = length($comment) - $max_msg;
                &error('本文入力エラー',"本文が長すぎます。$_ バイト削減してください。");
        }elsif ((!$pwd) || (length($pwd) > 8)) { $pwd = &random_string(8); }
        my($salt) = &random_string(2);
        $file_pwd = crypt($pwd,$salt);
        &get_date;

        open(LOG,$logfile) or  &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
        my($count, $last_nj);
        $count = <LOG>;chop($count);
        $last_nj = <LOG>;chop($last_nj);
        my(@all_log) = <LOG>;
        close(LOG);

        $this_nj = $OPT{'nj'};

        if (++$count > 9999) {
                &error('記事カウンタのオーバーフロー','登録記事数が 10,000 に達したため、投稿を受け付けることが出来ません。投稿を受け付けるには、既存の記事を再編成して掲示板の最適化を行う必要があります。管理者に連絡してください。');
#       }elsif ($this_nj eq $last_nj){
#               &error('二重投稿','二重投稿です。投稿ボタンが連打されてしまった可能性があります。一覧表示をリロードして記事が投稿されたか確認してください。再投稿の際は、投稿フォームをリロードして投稿をやり直してください。');
        }
        
        my($kiji_no) = substr("0000",length($count)).$count;

        $rhost = $ENV{'REMOTE_HOST'};
        $ipad  = $ENV{'REMOTE_ADDR'};

        if ($OPT{'no'} eq 'root') {
                $kiji_data = "$kiji_no<>root<>0<>$kiji_no<>$title<>$name<>$email<>$date_now<>0<>$file_pwd<>$rhost<>$ipad<>$comment\n";
                unshift(@all_log,$kiji_data);
        } else {
                foreach $tree (@all_log) {
                        if ($tn == (split(/<>/,$tree))[0]) {
                                @datas = &divide_log($tree);
                                $flag1 = 0; $flag2 = 0;
                                $kiji_data = "$kiji_no<>$OPT{'no'}<>$lx<>$tn<>$title<>$name<>$email<>$date_now<>0<>$file_pwd<>$rhost<>$ipad<>$comment";
                                foreach $data (@datas) {
                                        if (($flag2 == 1) && ($temp_lx >= (split(/<>/,$data))[2])){
                                                $tree_data = "$tree_data<#>$kiji_data";
                                                $flag2 = 2;
                                        }
                                        if ($flag1) { $tree_data = "$tree_data<#>$data"; }
                                        else { $tree_data = $data; $flag1 = 1; }
                                        if (($OPT{'no'} == (split(/<>/,$data))[0]) && (!$flag2)) {
                                                $flag2 = 1; $temp_lx = (split(/<>/,$data))[2];
                                        }
                                }
                                if ($flag2 == 1){ $tree_data = "$tree_data<#>$kiji_data"; }
                                unshift (@new,"$tree_data\n");
                        }
                        else { push (@new,$tree); }
                }
                @all_log = @new;
        }

        #容量オーバーした記事を削除
        if ($max_size < 1500) { $max_size = 1500; }
        $size = -s $logfile;
        while ($size > $max_size){
                my($delete) = pop(@all_log);
                $size -= length($delete);
                &delete_log($delete);
        }
        &write_file($count, $this_nj, @all_log);

        $COOKIE{'name'} = $name;
        $COOKIE{'email'} = $email;
        $COOKIE{'pwd'} = $pwd;
        &set_cookie;
  local($s) = $def_header_http.$defhead.$html_navi.'<h2>投稿の受理</h2>';
  $s .= <<"_EOF_";
<p>御投稿有難うございます。以下の内容を受理しました。</p>
_EOF_
  $s .= &kiji_view($kiji_data);
  print ($s.$deffoot);
  exit;
}

# [ 投稿者削除処理 ]

sub delete {
        my(@kiji_datas) = &divide_log(&search_tree);
        my($kiji_data) = &search_data(@kiji_datas);
        my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$file_pwd,$rhost,$ipad,$comment) = &divide_data($kiji_data);
        if (crypt($COOKIE{'pwd'},$file_pwd) ne $file_pwd) {
                &error('削除エラー','指定した記事の削除はできません。既に削除されていないか確認してください。どうしても削除したい場合は管理者に連絡してください。');
        }
        &get_date;

        #証拠を残しておく。
        &delete_log($kiji_data);

        open(LOG,$logfile) or  &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
        my($count, $last_nj);
        $count = <LOG>;chop($count);
        $last_nj = <LOG>;chop($last_nj);
        my($delete_notice);
        if (@kiji_datas == 1) {
                while (<LOG>) {
                        unless (/^$OPT{'no'}/) { push(@new,$_); }
                }
                $delete_notice = '<p>記事はツリーを構成していなかったため、完全に消滅しています。</p>';
        } else {
                my($kiji_data) = "$no<>$res<>$lx<>$tn<><del datetime=\"$datetime\">$title</del><em>(投稿者削除)</em><>$name<><>$date<>8<>Null<>$rhost<>$ipad<>投稿者によって削除されました。(削除: $date_now)";
                my($flag) = 0;
                my($tree_data);
                foreach (@kiji_datas) {
                        if ($flag) { $tree_data .= "<#>"; } else { $flag = 1; }
                        if (/^$OPT{'no'}/) { $tree_data .= $kiji_data; }
                        else { $tree_data .= $_; }
                }
                $tree_data =~ s/\n//;
                while (<LOG>) {
                        if (!/^$OPT{'tn'}/) { push(@new,$_); }
                        else { push(@new,"$tree_data\n"); }
                }
                $delete_notice = '<p>記事はツリーの一部を構成していたため、(投稿者削除) という記事に差し替えられています。</p>';
        }
        close(LOG);
        &write_file($count, $this_nj, @new);
        print &html_header("投稿者削除");
        print<<"_EOF_";
<hr>
<p>記事 No.$OPT{'tn'}「$title」を削除しました。</p>
$delete_notice
<p><a href="$this_name?$uri_query">一覧表示</a>をリロードして、記事が削除されたことを確認してください。</p>
<hr>
_EOF_
}

# [ データ処理関連汎用サブ ]

sub divide_log {
        my($data) = @_;
        chop($data);
        return split(/<#>/,$data);
}
sub divide_data {
        my $data = @_;
        return split(/<>/,$_[0]);
}

sub search_data {
        my(@kiji_datas) = @_;
        my($search_data_no) = $OPT{'no'};
        my($hit_data);
        foreach(@kiji_datas){
                if ( /^$search_data_no/ ) {
                        $hit_data = $_;
                        last;
                }
        }
        return $hit_data;
}

sub search_tree {
        my($search_tree_no) = $OPT{'tn'};
        my($hit_data);
        open(LOG,$logfile) or  &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
        my($count, $last_nj);
        $count = <LOG>;chop($count);
        $last_nj = <LOG>;chop($last_nj);
        while (<LOG>) {
                if ( /^$search_tree_no/ ){
                        $hit_data = $_;
                        last;
                }
        }
        close(LOG);
        return $hit_data;
}

# [ フォームからデータ取得 ]

sub read_form {
  %OPT = %Suika::CGI::param;
  return;
        my($pair,$buffer);
        if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
        } else { $buffer = $ENV{'QUERY_STRING'}; }
        my(@pairs) = split(/[&;]/,$buffer);     #パラメータ区切りに ; を使えるように改造。
        foreach $pair (@pairs) {
                my($name,$value) = split(/=/,$pair);
                $value =~ tr/+/ /;
                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                $OPT{$name} = &change_code($value);
        }
}

# [ クッキー処理 ]

sub get_cookie {
        my($pair,%DUMMY);
        my($cookies) = $ENV{'HTTP_COOKIE'};
        my(@pairs) = split(/;/,$cookies);
        foreach $pair (@pairs) {
                my($name,$value) = split(/=/,$pair);
                $name =~ s/ //g;
                $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
                $DUMMY{$name} = $value;
        }
        @pairs = split(/,/,$DUMMY{$cookie_name});
        foreach $pair (@pairs) {
                my($name,$value) = split(/:/,$pair);
                $COOKIE{$name} = &change_code($value);
        }
}
sub set_cookie {
        my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time + 30*24*60*60);
        $year += 100 if $year < 99;
        $year += 1900;
        $sec  = "0$sec" if $sec < 10;
        $min  = "0$min" if $min < 10;
        $hour = "0$hour" if $hour < 10;
        $mday = "0$mday" if $mday < 10;
        $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
        $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday];
        $date_gmt = "$youbi, $mday\-$mon\-$year $hour:$min:$sec GMT";
        my($cook);
        foreach $valname ('name','email','pwd'){
                my($tmp) = $COOKIE{$valname};
                $tmp =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
                $cook .= "$valname:$tmp,";
        }
        print "Set-Cookie: $cookie_name=$cook; expires=$date_gmt\n";
}

# [ 文字コード関連 ]

sub change_code {
        my($text)=$_[0];
        &jcode'convert(*text,$mojicode);
        $text =~ s/&/&amp;/g;
        $text =~ s/</&lt;/g;
        $text =~ s/>/&gt;/g;
        return $text;
}

# [ 日付取得 ]

sub get_date {
        $ENV{'TZ'} = "JST-9"; # TimeZone (日本時間 = 国際標準時(JST) - 9時間)
        my($sec,$min,$hour,$day,$mon,$year) = localtime();
        if ($year < 99) { $year += 100; }
        $year += 1900;
        $mon++;
        $sec = "0$sec"   if $sec < 10;
        $min = "0$min"   if $min < 10;
        $hour = "0$hour" if $hour < 10;
        $mon = "0$mon"   if $mon < 10;
        $day = "0$day"   if $day < 10;
        $date_now = "$year/$mon/$day $hour:$min:$sec";
        $datetime = "$year-$mon-${day}T$hour:$min:$sec+09:00";
}

# [ 記録ファイルの処理 ]

sub write_file {
        my($count,$this_nj,@lines) = @_;

        #プロセスID からテンポラリファイル名を生成
        $pros = $$;
        $pros = time unless $pros;
        $tmp_file = "$ID$pros.tmp";

        #他のテンポラリファイルを検索
        opendir(DIR,$log_dir) or  &error('システムエラー','作業ディレクトリのオープンに失敗しました。管理者が何かを忘れている可能性があります。');
        @list = readdir(DIR);
        closedir(DIR);
        unless (@list) { &error('システムエラー','作業ディレクトリが完全に空です。'); }
        @lists = grep(/$ID.*\.tmp/,@list);

        #テンポラリファイルがある場合
        my($retry_counter) = $retry;
        while (@lists) {
                if (--$retry_counter <= 0) {
                        #しびれを切らした
                        foreach (@lists) {
                                #テンポラリファイルを抹殺
                                unlink("$log_dir$_") if (-e "$log_dir$_");
                        }
                        &error('ビジー','ただ今混雑しています。時間をおいて再度実行してください。');
                }
                sleep(1);
                opendir(DIR,"$log_dir");
                @list = readdir(DIR);
                closedir(DIR);
                @lists = grep(/$ID.*\.tmp/,@list);
        }

        #テンポラリファイルに書き込む
        open(WRITE,">$log_dir$tmp_file") or &error('書き込みエラー','記録ファイルの書き込みが出来ません。管理者に連絡してください。');
        print WRITE "$count\n";
        print WRITE "$this_nj\n";
        print WRITE @lines;
        close(WRITE);

        #もう一度他のテンポラリファイルを検索
        opendir(DIR,$log_dir);
        @list = readdir(DIR);
        closedir(DIR);
        @lists = grep(/$ID.*\.tmp/,@list);
        @lists = grep(!/$tmp_file/,@lists);#自分自身は除外
        if (@lists) {#他で書き込み中であれば書き込みを中止して終了
                unlink("$log_dir$tmp_file") if (-e "$log_dir$tmp_file");
                &error('書き込みの競合','別の書き込みの処理中です。すこし時間をおいてから、再度ご利用下さい。');
        }
        rename("$log_dir$tmp_file",$logfile) or &error('書き込みの競合','書き込みに失敗しました。再度実行してください。');
        chmod 0666, $logfile;
}

sub delete_log{
        my($delete) = @_;
        open(WRITE,">> $arc_dir${ID}.txt") or &error('エラー','削除ログのシステムエラーです。管理者に連絡してください。');
        @datas = &divide_log($delete);
        @datas = sort(@datas);
        foreach $data (@datas) {
                my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
                print WRITE "No:$no $title\n";
                print WRITE "$date";
                print WRITE "$res へのコメント" unless ($res eq 'root');
                print WRITE "\n";
                $comment =~ s/<br>/\n/g;
                $comment =~ s/&gt;/>/g;
                $comment =~ s/&lt;/</g;
                $comment =~ s/&amp;/&/g;
                print WRITE "$comment\n\n";
        }
        close(WRITE);
}

sub random_string{
        my($str_length) = @_;
        my($str,$i);
        srand();
        for ($i=0; $i<$str_length; $i++){
                $str .= substr('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789./', int(rand(64)),1);
        }
        return $str;
}

# [ エラー処理 ]

sub error {
        my($err_msg,$err_description) = @_;
        print<<"_EOF_";
Content-type: text/html; $charset_code
Content-Language: ja

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
 "http://www.w3.org/TR/html4/strict.dtd">
<html lang="ja">
<head>
$link_element
<link rel="stylesheet" href="/s/simpledoc">
<link rel="stylesheet" href="../bo-style">
<title>(エラー報告)</title>
</head>
<body>
<h1><a name="top">エラー</a></h1>
<h2>$err_msg</h2>
<p>$err_description</p>
_EOF_
&html_footer;
        exit;
}

sub method_error{
        print<<"_EOF_";
Status: 405 Method Not Allowed
Allow: POST
Content-type: text/html; $charset_code
Content-Language: ja

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
 "http://www.w3.org/TR/html4/strict.dtd">
<html lang="ja">
<head>
<link rel="stylesheet" href="/s/simpledoc">
<link rel="stylesheet" href="../bo-style">
<title>(エラー報告)</title>
</head>
<body>
<h1><a name="top">エラー</a></h1>
<h2>不正投稿</h2>
<p>アクセスは受け入れられませんでした。外部からの不正な投稿が行われた可能性があります。</p>
_EOF_
&html_footer;
        exit;
}

sub navi_form{
        my($tree_count) = @_;
        my($this_page,$page_navi);
        my($tmp_query) = $uri_query;
        $tmp_query =~ s/;tree=\d+//;
        if($tree_count){
                for ($i = 0; $i < $tree_count; $i += $max_tree) {
                        $j = $i / $max_tree + 1;
                        if ($tree == $i) {
                                $this_page = $j;
                        } else {
                                $page_navi .= "/ <a href=\"$this_name?$tmp_query;tree=$i\">$jページ</a>\n"
                        }
                }
        }
        $page_navi .= "( $this_page / $j ページ )" if $j > 1;
        print<<"_EOF_";
<div class="pagenavi"><hr>
<p><a href="$this_name?$uri_query;md=new">新規投稿</a>
$page_navi</p>
<hr></div>
_EOF_
}

sub nazo_only{
        my(%nazo);
        my(@env);
        my($name, $value);
        open(LOG, $logfile) or  &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
        while(<LOG>){
                while( m|(【.+?】)|g ){
                        $nazo{"$1"} ++;
                }
        }
        close(LOG);
        print &html_header("謎統計情報");
        if(%nazo){
                print '<ul>';
                while (($name, $value) = each(%nazo)){
                        push(@env, "$name = $value");
                }
                foreach (sort(@env)){
                        print "<li><p>$_</p></li>";
                }
                print '</ul>';
        }else{
                print '<p>Not Found.</p>';
        }
        &html_footer;
        exit;
}

sub location{
        my($location) = @_;
        print <<"_EndOfText_";
Status: 302 Found
Location: $location
Content-Type: text/html; charset=EUC-JP
Content-Language: ja

_EndOfText_
        print &html_header("$location");
        print "<p><a href=\"$location\">$location</a> を参照してください。</p>";
        &html_footer;
        exit;
}

sub add_query{
        my($name, $value) = @_;
        $uri_query .= ";$name=$value";
        $form_query .= "<input type=\"hidden\" name=\"$name\" value=\"$value\">";
}

sub squelch{
        my($data) = @_;
        #謎をスケルチする
        if( $nazo eq 'no' ){
                $data =~ s/(【[^<]+?】)/<del class="nazo">$1<\/del>/g;
        }
        return $data;
}