#!/usr/local/bin/perl require 'jcode.pl'; $ENV{'TZ'} = "JST-9"; $datafile = '/home/username/tbbs.txt'; #メッセージを格納するファイル $datalock = '/home/username/tbbs.lck'; #ロック状態確認ファイル $cntfile = '/home/username/tbbscnt.txt'; #メッセージ最終番号 $cntlock = '/home/username/tbbscnt.lck'; #ロック状態確認ファイル $body = ""; if ($ENV{'REQUEST_METHOD'} eq "POST") {read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'}) ;} else { $buffer = $ENV{'QUERY_STRING'} ;} @pairs = split(/&/,$buffer); foreach $pair (@pairs) { ($name,$value) = split(/=/,$pair); $value =~ tr/+/ /; $value =~ s/%(..)/pack("C",hex($1))/eg; &jcode'convert(*value,'sjis'); $value =~ s/\,/\,/g; $value =~ s//\>/g; $FORM{$name} = $value; } $name = $FORM{'name'}; $msgid = $FORM{'msgid'}; $resid = $FORM{'resid'}; $subject = $FORM{'subject'}; $comment = $FORM{'comment'}; $opt = $FORM{'opt'}; $remoteaddx = $ENV{'HTTP_X_FORWARDED_FOR'}; $remoteaddr = $ENV{'REMOTE_ADDR'}; $remoteport = $ENV{'REMOTE_PORT'}; if ($remoteaddx ne "") {$remoteaddr = $remoteaddx ;} $comment =~ s/\015\012/
/g; $comment =~ s/\015/
/g; $comment =~ s/\012/
/g; $comment =~ s/\n/
/g; if ($opt eq "newmsg") { &newmsg; } if ($opt eq "resview") { &resview; } if ($opt eq "reswrt") { &reswrt; } if ($opt eq "msgwrt") { &msgwrt; } &treelist; exit; sub treelist{ @mdt = `sort +0 -1 -b -n -r -t, $datafile`; &htmlhead; print "
\n";

  foreach $msgrec (@mdt){
    @res = split(/\t/,$msgrec);
    $idxdata = shift(@res);
    ($lastmsgwt,$msgid,$eol) = split(/\,/,$idxdata);

    $patbk = "";
    $lastrec = $#res;
    for ($i=$lastrec;$i>0;$i--){
      ($ridx,$ract,$rsubject,$rname,$rtime,$rcomment,$reol) = split(/\,/,$res[$i]);
      $patlen = length($ridx) /2;
      $pat = &PatternSet($patlen,$patbk);
      $tree[$i] = &TreeImg($pat,$patbk);
      $patbk = $pat;
    }
    $tree[0] = "";
    for ($i=0;$i<=$lastrec;$i++){
      &listwrt($msgid,$tree[$i],$res[$i]);
    }
    print "
\n";
  }

print "
\n"; } sub PatternSet { my ($CurSize,$OldPattern) = @_; my ($OldSize) = length($OldPattern); my ($ANS,$i) ; if ($OldSize == $CurSize) {$ANS = $OldPattern;} else { if ($OldSize < $CurSize) { $i = $CurSize - $OldSize; if ($i > 1) { $i--; $OldPattern .= ("0" x $i); } $ANS = $OldPattern . "1"; } else { $i = length($OldPattern) -2; $ANS = substr($OldPattern,0,$i) . "1"; } } return $ANS; } sub TreeImg { my($NewPat,$OldPat) = @_; my($NewPatLen,$WKimg,$i,@Nchar,@Ochar); $WKimg = ""; @Nchar = split(//,$NewPat); @Ochar = split(//,$OldPat); $NewPatLen = $#Nchar; for ($i=0;$i<=$NewPatLen;$i++) { if ($i < $NewPatLen) { if ($Nchar[$i] eq "1") {$WKimg .= " ┃";} else {$WKimg .= " 　";} } else { if ($Ochar[$i] eq "1") {$WKimg .= " ┣";} else {$WKimg .= " ┗";} } } return $WKimg; } sub listwrt{ my ($msgid,$tree,$rec) = @_; my ($resid,$act,$subject,$name,$time,$comment,$eol) = split(/\,/,$rec); if ($tree eq "") {$resid="";} print qq{$tree }; print qq{}; print qq{$subject }; print qq{$name }; print qq{}; print &timefmt($time); print qq{}; print "\n"; } sub timefmt{ my($parm) = @_; my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($parm); my($ltime) = sprintf("%04d/%02d/%02d %02d:%02d:%02d",($year+1900),($mon+1),$mday,$hour,$min,$sec); return $ltime; } sub newmsg{ print < $body 新しい記事です。 HEADER &htmlform("msgwrt","","",""); print "\n"; exit; } sub resview{ &htmlhead; $msgrec = `awk "/^[0-9]+\,$msgid\,/" $datafile`; @resall = split(/\t/,$msgrec); $lmtime = shift(@resall); @res = grep(/^$resid/,@resall); $lastrec = $#res; for ($i=0;$i<=$lastrec;$i++){ &msgview($resid,$res[$i]); } &htmlform("reswrt","","re:",""); print "\n"; exit; } sub msgview{ my($resbase,$rec) = @_; my($tresid,$tact,$tsubject,$tname,$ttime,$tcomment,$teol) = split(/\,/,$rec); my($chk,$spc,$spcm); $chk = length($tresid) - length($resbase); $spc = $chk * 20 + 2; $spcm = $spc + 7; print qq{\n}; print qq{
}; print qq{}; print qq{$tsubject }; print qq{$tname }; print qq{}; print &timefmt($ttime); print qq{}; print qq{
\n}; print qq{
\n}; print qq{$tcomment\n}; print qq{
\n}; print qq{
\n}; } sub reswrt{ my(@mdt,$lastrec,@res,$idxdata,$lastmsgwt,$fmsgd,$eol); my(@wk,$rescnt,$id,$time,$newrec); foreach (1 .. 20) { if(symlink($datafile,$datalock)){last;} sleep(1); } open(msgf,$datafile); @mdt = ; close(msgf); $lastrec = $#mdt; for ($i=0;$i<=$lastrec;$i++){ @res = split(/\t/,$mdt[$i]); chomp($res[$#res]); $idxdata = shift(@res); ($lastmsgwt,$fmsgid,$eol) = split(/\,/,$idxdata); if ($msgid eq $fmsgid) { @wk = grep(/^$resid[0-9][0-9]\,/,@res); $rescnt = @wk; $rescnt++; $id = $resid . sprintf("%02d",$rescnt); $time = time; $newrec = join(",",$id,"",$subject,$name,$time,$comment,""); push(@res,$newrec); @resw = sort(@res); $idxdata = join(",",$time,$msgid,""); $mdt[$i] = join("\t",$idxdata,@resw); $mdt[$i] .= "\n"; $i = $lastrec +1; } } open(msgf,">$datafile"); print msgf @mdt; close(msgf); unlink($datalock); } sub msgwrt{ my($count,$time,$msgid,$setmsgid,$idxdata,$newrec,$msgrec); foreach (1 .. 10) { if(symlink($cntfile,$cntlock)){last;} sleep(1); } open(cntf,$cntfile); $count = ; close(cntf); $count++; open(cntf,">$cntfile"); print cntf $count; close(cntf); unlink($cntlock); $time = time; $setmsgid = sprintf("%05d",$count); $idxdata = join(",",$time,$setmsgid,""); $newrec = join(",","","",$subject,$name,$time,$comment,""); $msgrec = join("\t",$idxdata,$newrec); $msgrec .= "\n"; open(msgf,">>$datafile"); print msgf $msgrec; close(msgf); } sub htmlhead{ print < $body
HEADER } sub htmlform{ my($wopt,$fname,$fsubject,$fcomment) = @_; print <
名前:
題名:

MSGFORM }