#!/usr/local/bin/perl
# *** This file is written by EUC code ***
# *** 3 gyou sita no nihongo ga mojibake suru baaini wa
# *** kono fairu wa EUC to site hirakarete imasen.
# *** EUC kohdo no fairu to shite hiraite kudasai.
#     このファイルはＥＵＣコードで書かれています。
#
# program name : gb.cgi (guest book cgi for EUC code page)
#
# function     : (1) count guest number and message number.
#                (2) show form for new message.
#                (3) show messages written on book1.
#                (4) add new message to book1.
#
# note         : This gb.cgi is first made for BIGLOBE(mesh) by perl ver.4.
#
# programmer   : makoto takenaka : takesoft@mxs.meshnet.or.jp
#
# copyright    : (c) 1996, 1997 by Makoto Takenaka
#
# version(date):
#     1.0(Sept 25, 1996)
#     1.1(Sept 30, 1996) Error stop for print(BOOKi <BOOKj>);
#     1.2(Oct   4, 1996) Change <TITLE>.
#     1.3(Oct  10, 1996) Change (") to (\") in (print <<EOF) sequence.
#     1.4(Oct  22, 1996) Change TEXTAREA attributes to
#                        "COLS=70 ROWS=5 WRAP=hard".
#                        Change $limit from 30000 to 50000.
#                        Use localtime(time) for $date.
#                        Change print for no $url or no $mail input.
#     1.5(Oct  31, 1996) Add owner mode using password in name field.
#     1.6(Nov  12, 1996) Check (size of book1) = (size of book2).
#     1.7(Nov  14, 1996) Add flock for read only file, check book2 size in(4.4)
#                        and change die to exit in sub error_message.
#                        Rewrite $m_count after new message is added to book1,
#                        Insert comment for old message anchor tags.
#                        Change section number of subroutine show_html.
#                        Change 0-adding method in $date.
#     2.0(Dec  12, 1996) Change double quotations to single quotations in
#                        substitutions of $password, $owner_name, $owner_url 
#                        and $owner_mail. "o" is added in next line for bad
#                        implementation of perl.
#                        $value =~ s/&/&amp;/go;
#     2.1(Dec  18, 1996) Make $msg_limit, limit of $message.
#                        $name and $mail is required for message.
#                        Use truncate.
#     2.2(Jan  12, 1997) Change horizontal lines.
#     2.3(Jan  31, 1997) Add sub wrap to word-wrap $message for the other 
#                        browsers except Netscape Navigator 2.0/3.0
#     2.4(Feb  13, 1997) Change escape codes after sub wrap for $message.
#                        Change to "$year += 1900;", this works well until 
#                        2038/01/19. Change "local($jc) in sub wrap.
#
# calling form : <A HREF="***/gb.cgi"> called from other Web page.
#                <FORM METHOD="POST" ACTION="***/gb.cgi"> called from 
#                form in this cgi.
#                *** is directory where gb.cgi is placed.
#
#(0) Print type of data and include jcode.pl.
#
print "Content-type: text/html\n\n";
require 'jcode.pl';
#
#(1) set constants.
#
   $limit        = 50000;              # limit of book1 in bytes
   $msg_limit    = 2000;               # limit of $message (bytes)
   $msg_limit2   = $msg_limit/2;       # limit of $message (zenkaku chars)
   $line_limit   = 77;                 # limit of bytes in a line
   $home_page    = "../index.html";    # first web page html file
   $pwd          = "./";               # present working directory
   $book1        = $pwd."book1.html";  # file name of book1
   $book2        = $pwd."book2.html";  # file name of book2
   $g_count_file = $pwd."g_count.txt"; # number of guests 
   $m_count_file = $pwd."m_count.txt"; # number of messages
#
#  Change next four variables to your own data.
#
   $password     = 'gbmaster3';        # password for owner mode
   $owner_name   = '管理者';           # owner name
   $owner_url    = 'http://www2a.meshnet.or.jp/~user-id/';
   $owner_mail   = 'user-id@xxx.yyyyyyy.or.jp';
#
   $line_limit     = $line_limit - 1;  # Adjust $line_limit
   $textarea_limit = $line_limit - 6;  # limit of bytes in line for hard wrap
   if(-e $book1)
      {$book1_byte = (-s $book1);}
   else
      {&error_message("(1): File $book1 is not found.");}
#
   if(-e $book2)
      {$book2_byte = (-s $book2);}     # Get size of book2.
   else
      {&error_message("(1): File $book2 is not found.");}
#
#(2) get parameters from sent data.
#
if ($ENV{'REQUEST_METHOD'} eq "POST")
   {
   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});  
   }
else
   {
    $buffer = $ENV{'QUERY_STRING'};
   }
#
   @pairs = split(/&/, $buffer);
#

   foreach $pair (@pairs)
      {
      ($pname, $value) = split(/=/, $pair);
      $value =~ tr/+/ /;
      $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
      &jcode'convert(*value, 'euc');  # Convert to EUC code
      if($pname ne 'message')
         {
         $value =~ s/&/&amp;/g;          # Change & to &amp;
         $value =~ s/\x22/&quot;/g;      # Change " to &quot;
         $value =~ s/</&lt;/g;           # Change < to &lt;
         $value =~ s/>/&gt;/g;           # Change > to &gt;
         }
      $value =~ s/\x0D\x0A/\x0A/g;    # Change CR LF to LF
      $value =~ s/\x0D/\x0A/g;        # Change CR to LF
      $parameters{$pname}    = $value;
      }
#
   $name = $parameters{'name'};
   $url  = $parameters{'url'};
   unless($url)
      {
      $url = "http://";
      }
   $mail      = $parameters{'mail'};
   $message   = $parameters{'message'};
   if(length($message) > $msg_limit)
      {$message = substr($message, 0, $msg_limit);} # Cut long message.
#
#  Wrap $message if characters in a line is greater than $line_limit.
#
   &wrap(*message, $line_limit);
#
   $message =~ s/&/&amp;/g;             # Change & to &amp;
   $message =~ s/\x22/&quot;/g;         # Change " to &quot;
   $message =~ s/</&lt;/g;              # Change < to &lt;
   $message =~ s/>/&gt;/g;              # Change > to &gt;
#
   if($name =~ /^$password\b/)
      {
      $owner_mode = "yes";
      $name       = $owner_name;
      if($url eq "http://") {$url        = $owner_url;}
      unless($mail)         {$mail       = $owner_mail;}
      }
#
   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   $year += 1900;   # Add 1900, which is valid until 2038/01/19.
   $mon++;
   $thisday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday];
   if ($sec  < 10)  {$sec  = "0$sec";}
   if ($min  < 10)  {$min  = "0$min";}
   if ($hour < 10)  {$hour = "0$hour";}
   if ($mday < 10)  {$mday = "0$mday";}
   if ($mon  < 10)  {$mon  = "0$mon";}
#
   $date = "$year/$mon/$mday $thisday $hour:$min:$sec";
#
#(3) show form and book1 and exit if message is empty (called from <A> tag or
#    submitted without message).
#
   unless($name && $mail && $message)
      {
      &show_html(1);
      exit 0;
      }
#
#(4) Add new message to book1.
#
#(4.1) Read message number $m_count.
#
   open(COUNTFILE, "$m_count_file")
      || &error_message("(4.1):Unable to open $m_count_file");
   $m_count = <COUNTFILE>;
   $m_count = $m_count + 1;
   close(COUNTFILE);
#
#(4.2) Write new message to book2.
#
   open(BOOK2, "+<$book2")
      || &error_message("(4.2):Unable to open $book2");
   flock(BOOK2, 2);
#
   print BOOK2 "<HR>\n";
   if($url ne "http://")
      {
      if($owner_mode)
         {
         print BOOK2 "[$m_count]<A HREF=\"$url\">$name </A>";
         }
      else
         {
         print BOOK2 "[$m_count]<A HREF=\"$url\">$name さん</A>";
         }
      }
   else
      {
      print BOOK2 "[$m_count] $name さん";
      }
   if($mail)
      {
      print BOOK2 "(<A HREF=\"mailto:$mail\">$mail</A>) $date\n";
      }
   else
      {
      print BOOK2 " $date\n";
      }
#
   print BOOK2 "<PRE>\n$message\n</PRE>\n";
#
#(4.3) Add old message in book1 to book2.
#
   open(BOOK1, "+<$book1")
      || &error_message("(4.3): Unable to open $book1");
   flock(BOOK1, 2);
   print(BOOK2 <BOOK1>)
      || &error_message("(4.3): Unable to add BOOK1 to BOOK2");
#
   truncate(BOOK2, tell(BOOK2));
#
#(4.4) Copy book2 to book1.
#
   seek(BOOK1, 0, 0);
   seek(BOOK2, 0, 0);
#
   print(BOOK1 <BOOK2>)
      || &error_message("(4.4): Unable to copy BOOK2 to BOOK1");
   flock(BOOK1, 8);
   close(BOOK1);
   flock(BOOK2, 8);
   close(BOOK2);
#
#(4.5) Incremet $m_count on $m_count_file.
#      No increment for error between (4.2)-(4.4)
#      Increment to written $m_count because another process may
#      increment $m_count during (4.2)-(4.4).
#
   open(COUNTFILE, "+< $m_count_file")
      || &error_message("(4.5):Unable to open $m_count_file");
   flock(COUNTFILE, 2);
   $m_count = <COUNTFILE>;
   $m_count = $m_count + 1;
   seek(COUNTFILE, 0, 0);
   print COUNTFILE $m_count;
   flock(COUNTFILE, 8);
   close(COUNTFILE);
#
#(5) Show form and messages.
#
   &show_html(0);
   exit 0;                # End of Main Program
#
#  subroutine show_html
#
sub show_html
{
local($incr) = @_; 
#
# $incr = 1 if called from <A> tag, $incr = 0 if called from this form.
#
#(S1) set guest number $g_count.
#
if ($incr > 0)
   {
   open(COUNTFILE, "+< $g_count_file")
      || &error_message("show_html:Unable to open $g_count_file");
   flock(COUNTFILE, 2);
   $g_count = <COUNTFILE>;
   $g_count = $g_count + $incr;
   seek(COUNTFILE, 0, 0);
   print COUNTFILE $g_count;
   flock(COUNTFILE, 8);
   close(COUNTFILE);
   }
else
   {
   open(COUNTFILE, "$g_count_file") 
      || &error_message("show_html:Unable to open $g_count_file");
   $g_count = <COUNTFILE>;
   close(COUNTFILE);
   }
#
#(S2) set message number $m_count.
#
   open(COUNTFILE, "$m_count_file") 
      || &error_message("show_html:Unable to open $m_count_file");
   $m_count = <COUNTFILE>;
   close(COUNTFILE);
#
#(S3) Show head part of guest book page.
#
print <<EOF;
<HTML>
<HEAD>
<TITLE>Guest Book</TITLE>
</HEAD>
<BODY BGCOLOR=\"#CCFFCC\">
<FONT FACE=\"ＭＳ ゴシック\">
[guest# $g_count][message# $m_count][book1 size $book1_byte B]
EOF
# Next line is an example of anchor tag to old message data.
# print "[<A HREF=\"msg100.html\">message 1-100</A>]\n";
print <<EOF;
[<A HREF=\"$home_page\">ホームページへ戻る</A>]<BR>
<HR SIZE=3>
<CENTER>
<H1>掲示板</H1>
</CENTER>
EOF
#
#(S4) Show form for message.
#
if($owner_mode){$name = $password;}
#
if($book1_byte < $limit)
   {
   print <<EOF;
<HR SIZE=3>
<FORM METHOD=\"POST\" ACTION=\"gb.cgi\">
Webページに対する御意見御要望をどんどんお書き下さい。下の
”送る”ボタンを押すと送付され、このフォームの下に表示されます。
半角カタカナは文字化けしますので使用しないで下さい。”送る”ボタンを
押してから応答があるまでの間には、”送る”ボタンや再読み込みボタンを
押さないで下さい。二重書き込みになります。
<BR><BR>
   お名前(必ずお書き下さい)<BR>
   <INPUT NAME=\"name\" SIZE=40 MAXLENGTH=200 VALUE=\"$name\"><BR>
   貴方のホームページのURL<BR>
   <INPUT NAME=\"url\" SIZE=40 MAXLENGTH=200 VALUE=\"$url\"><BR>
   メールアドレス(必ずお書き下さい)<BR>
   <INPUT NAME=\"mail\" SIZE=40 MAXLENGTH=200 VALUE=\"$mail\"><BR>
   メッセージ(全角 $msg_limit2 文字まで。
   Netscape Navigator 2.0以上の場合自動改行。その他の場合一行が
   $line_limit バイトを越えると強制改行)<BR>
   <TEXTAREA NAME=\"message\" COLS=$textarea_limit ROWS=5 WRAP=hard></TEXTAREA>
   <BR>
   <INPUT TYPE=\"submit\" VALUE=\"　送る　\">
   <INPUT TYPE=\"reset\" VALUE=\"リセット\"><BR>
   </FORM>
EOF
   }
else
   {
   print <<EOF;
   <HR SIZE=3>
   申し訳ありません。<BR>
   今は、掲示板ファイルがいっぱいになったか、掲示板ファイルに<BR>
   異常が発生したので書き込めません。<BR>
   またの御利用をお願いします。<BR>
   <HR SIZE=3>
EOF
   }
#
#(S5) Print book1.
#
open(BOOK1, "$book1") 
   || &error_message("show_html:Unable to open $book1");
print <BOOK1>; #print whole book1 to STDOUT.
close(BOOK1);
#
#(S6) Print last part of guest book page.
#
   print "<P ALIGN=RIGHT>\n";
# Next line is an example of anchor tag to old message data.
#  print "[<A HREF=\"msg100.html\">message 1-100</A>]\n";
   print <<EOF;
<A HREF=\"$home_page\">ホームページへ戻る</A>
</P>
<HR>
<!------------------------------------------------------------------->
<P>
初期設置日：1997年2月13日/最終変更日：1997年2月13日/gb (ver.2.4)
</P>
</FONT>
</BODY>
</HTML>
EOF
}                          # END of SUBROUTINE show_html
#
# SUBROUTINE wrap
#
sub wrap
{
   local(*msg, $limit) = @_;
#
#  This subroutine wrap $msg, so that each line length is less or equal 
#  to ($limit + 1). Return number of lines in new $msg.
#
   local(@old_lines, @new_lines, @byte_lines, $max, $len, $iline, $i, $line);
   local($jc);
#
#(w1) Set constants.
#
   $jc = '[\241-\376][\241-\376]'; # EUC code
#
#(w2) Split $msg into lines.
#
   @old_lines = split(/\n/, $msg);
#
#(w3) Check length of each lines.
#
   $max = 0;
   foreach $i(0..$#old_lines)
      {
      $len = length($old_lines[$i]);
      $byte_lines[$i] = $len;
      $max = ($max > $len) ? $max : $len ;
      }
#
   if($max <= $limit){return ($#old_lines + 1);}
#
#(w4) Wrap long lines.
#
   $iline = 0; #new line number
#
   foreach $i(0..$#old_lines)
      {
      if($byte_lines[$i] <= $limit)
         {
         $new_lines[$iline] = $old_lines[$i];
         $iline++;
         }
      else
         {
         $line = ''; # Clear $line.
         $len  = 0;
         $_ = $old_lines[$i];
#
         while(length($_))
            {
            $zen_space = int(($limit - $len + 1)/2);
            s/^(($jc){1,$zen_space}|.)// ;
            $line .= $&;
            $len   = length($line);
            if($len >= $limit)
               {
               $new_lines[$iline] = $line;
               $line = '';
               $len  = 0;
               $iline++;
               }
            }
         if($len)
            {
            $new_lines[$iline] = $line;
            $iline++;
            }
         }
      }
   $msg = join("\n", @new_lines);
   $iline; # Return number of lines in new $msg.
}
#
# SUBROUTINE error_message
#
sub error_message
{
   local($msg) = @_;
#
#  print message and stop this perl program.
#
   print $msg;
   exit 1;
}