#! /usr/local/bin/perl ###################################### #BooBBS v2.40 / this program is free.# #(C) BooBooClub 1998-2006 # ###################################### #set data $max = '30'; $cgi = './bbbs.cgi'; $dat = './bdata.dat'; $admin = './badmin.cgi'; $address = 'Admin@mail.address'; $bbstitle = 'BooBBS'; $head = 'BooBBS'; $linkname = 'Back'; $linkurl = './linkurl'; $back = 'bgcolor="#ffffff"'; $linkc= 'text="#000000" link="#0000ff" vlink="880088"'; $nomail = '#888888'; $fonts = '2'; $type = 't'; $autolink = 'on'; $faq = 'on'; #read lib require 'jcode.pl'; #lock check $lockfile = './lock/lockfile'; $retry = 1; until(symlink("$dat", "$lockfile")){ if(++$retry >= 30){ unlink("$lockfile"); exit 0; } sleep(1); } #time $ENV{'TZ'}='JST-9'; ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $year = ($year + 1900); $mon++; if ($sec < 10) { $sec = "0$sec";} if ($min < 10) { $min = "0$min";} if ($hour < 10){ $hour = "0$hour";} if ($mon < 10) { $mon = "0$mon";} if ($mday < 10){ $mday = "0$mday";} $time = "$year/$mon/$mday $hour:$min:$sec"; #read 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/\cM\n//g; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/\,//g; $value =~ s//>/ig; $value =~ s/\r\n|[\r\n]/
/ig; &jcode'convert(*value,'sjis'); $FORM{$name} = $value; } #branch if($FORM{'submit'} ne '書き込み'){ &html; } else{ ✓ &write; &html; } sub check{ if($FORM{'name'} eq ''||$FORM{'title'} eq ''||$FORM{'txt'} eq ''){ &error; } } sub write{ open (DAT,"$dat"); @bbsdats = ; close (DAT); if($autolink eq 'on'){ $FORM{'txt'} =~ s/(http:[\w\.\/\~\+\-\?%=&^]+)/$1<\/a>/g; $FORM{'txt'} =~ s/([\w\.\-]+@[\w\.\-]+)/$1<\/a>/g; } elsif($autolink eq 'onw'){ $FORM{'txt'} =~ s/(http:[\w\.\/\~\+\-\?%=&^]+)/$1<\/a>/g; $FORM{'txt'} =~ s/([\w\.\-]+@[\w\.\-]+)/$1<\/a>/g; } $wrt = "$FORM{'name'}\,$FORM{'mail'}\,$FORM{'title'}\,$FORM{'txt'}\,$time\n"; unshift(@bbsdats,$wrt); $hml = @bbsdats; if($hml > $max){ $max--; @ndat = @bbsdats[0..$max]; } else{ @ndat = @bbsdats; } #write new dat open (DAT,">$dat"); print DAT @ndat; close (DAT); } sub html{ #get dat open (DAT,"$dat"); @bbsdats = ; close (DAT); #html print "Content-type: text/html\n\n"; print "$bbstitle\n"; print "\n"; print "
\n"; print "$head\n"; print "
\n"; if($type eq "b"){ print "
[書き込み]\n"; } if($faq eq 'on'){ print " [FAQ]\n"; } print " [Mail to Admin]\n"; print " [For Admin]\n"; print " [$linkname]\n"; print "
\n"; if($type eq "b"){ &view; &form; print "
\n"; } else{ print "
\n"; &form; &view; } print "
Produced by BooBooClub

\n"; print "\n"; unlink("$lockfile"); exit 0; } sub view{ print "
\n\n"; foreach $bbsdat(@bbsdats) { ($name,$mail,$title,$txt,$time) = split(/,/,$bbsdat); print "
$title
"; if($mail ne ""){ print "$name "; } else{ print "$name "; } print "$time
"; print "
$txt\n\n"; } print "
\n"; print "
\n"; } sub form{ print "
\n"; print "
\n"; print "名前 :\n"; print "\n"; print "
\n"; print "E-mail:\n"; print "\n"; print "
\n"; print "件名 :\n"; print "\n"; print "
\n"; print "内容 :\n"; print "\n"; print "

\n"; print "     "; print " \n"; print "
\n"; print "

\n"; print "
\n"; } sub error{ print "Content-type: text/html\n\n"; print "$bbstitle\n"; print "\n"; print "

Error



\n"; print "未記入欄があります。再入力してください。\n"; print "
\n"; unlink("$lockfile"); exit 0; }