#!/usr/mesh/bin/perl
#
# program name  : checkmsg.cgi(Check Submitted Message)
#
# function      : Show input data to user and reconfirm to submit the message.
#
# programmer    : makoto takenaka   (takesoft@mxs.meshnet.or.jp)
#
# copyright     : (c) 1996, 1997 by Takesoft
#
# version(date) :
#    1.0 (Dec 7, 1996)
#    1.1 (Jan 24, 1997) Limit the length of message and add notes.
#    1.2 (Jan 29, 1997) Fix (5.3) $name quotation process,
#                       correct $msg_file[0], $msg_file[1] and
#                       add $addmsg_cgi, $commsg_cgi.
#    1.3 (Jan 31, 1997) Add sub wrap to word-wrap $message for the other 
#                       browsers except Netscape Navigator 2.0/3.0
#    1.4 (Feb 12, 1997) Change (" & < >) to escape codes after sub wrap
#                       in case of $message.
#
#(1) Send header lines to browser and prepare jcode.pl.
#
   print "Content-type: text/html\n\n";
   require 'jcode.pl';
#
#(2) set constants.
#
   $msg_limit    = 2000;               # Limit of length of message(bytes)
   $line_limit   = 77;                 # limit of bytes in a line
   $base_dir     = "./";               # base directory of CLWB
   $home_url     = "../index.html";    # URL of first Web page
   $clwb_cgi     = "./clwb.cgi";       # URL of clwb.cgi
   $addmsg_cgi   = "./addmsg.cgi";     # URL of addmsg.cgi
   $commsg_cgi   = "./commsg.cgi";     # URL of commsg.cgi
   $password     = 'clwb777';          # password for owner mode
   $owner_name   = 'Boadmaster';       # owner name(assign by input code)
   $owner_url    = 'http://www2a.meshnet.or.jp/~user-id/';
   $owner_mail   = 'user-id@mxs.meshnet.or.jp';
   $web_code     = 'euc'; #Japanese code of title/msg file:'sjis', 'euc', 'jis'
   $san          = 'san'; # san in $web_code
   $msg_from[0] = 1;      # first message number of $msg_file[0]
   $msg_file[0] = "${base_dir}msg001.html"; # first message file
#  $msg_from[1] = 201;                      # sample of second message file
#  $msg_file[1] = "${base_dir}msg002.html"; # sample of second message file
#
#  $owner_mode   = "";                 # = 1; if owner mode.
   $line_limit     = $line_limit - 1;  # Adjust $line_limit
   $textarea_limit = $line_limit - 6;  # limit of bytes in line for hard wrap
#
#(3) get parameters from input 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, $web_code); # Convert to $web_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;
      }
#
   $owner_mode = $parameters{'owner_mode'};
   $to         = $parameters{'to'};
   $name       = $parameters{'name'};
   $url        = $parameters{'url'};
   $mail       = $parameters{'mail'};
   $title      = $parameters{'title'};
   $message    = $parameters{'message'};
#
#(4) Check owner mode and length of the message.
#
   if($name =~ /^$password\b/)
      {
      $owner_mode = 1;
      $name       = $owner_name;
      if(!$url || ($url eq "http://")) {$url  = $owner_url;}
      unless($mail)         {$mail = $owner_mail;}
      }
#
   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, $web_code);
#
   $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;
#
#(5) Get user $name, $url and $mail if inputted $name is message number.
#
#(5.1) Check $name is message number or not.
#
   if(!$name){$name_is_number = 0;}
   elsif($name =~ /[^\d\s]/){$name_is_number = 0;}
   else                  {$name_is_number = 1;}
#
   if($name_is_number && ($name > 0))
      {
      $tname = $name;
      $tname =~ s/^\s+//; # Trim $name.
      $tname =~ s/\s+$//;
#
#(5.2) Find message file of number $tname messge.
#
      foreach $i (0 .. $#msg_from)
         {
         if($msg_from[$i] > $tname)
            {
            $n    = $i - 1;
            last;
            }
         $n = $i;
         }
#
      $msg_html = $msg_file[$n];
#
#(5.3) Find message number.
#
      open(MSG_FILE, "$msg_html")
         || &error_message("(5.3):Unable to open $msg_html");
#
      $found = 0;
      while(<MSG_FILE>)
         {
         if(/<!--BM:MSGN=$tname/)
            {
            $found = 1;
#           ($icode) = (/ICODE=([^:]*)/);
            $_ = <MSG_FILE>;
# $url
            if(!$url || ($url eq "http://"))
               {
               ($url) = (/http:([^\"]*)/);
               if($url){$url = 'http:'.$url;}
               }
# $mail
            unless($mail)
               {
               ($mail) = (/mailto:([^\"]*)/);
               }
# $name
            s/\(<.*>\)//;               # Remove mail address if exists.
            s/<[^>]*>//g;               # Remove tags.
            ($name) = (/\](.*)\d\d\/\d\d\/\d\d/);
            $name =~ s/^\s+//;          # Trim $name.
            $name =~ s/\s*($san)\s*$//; # Cut $san.
            last;
            }
         }
      close(MSG_FILE);
#
      unless($found)
         {
         print "<H2>Message #$tname is not found in file $msg_html<H2>\n";
         }
      }
#
#(6) Show input data.
#
print <<EOF;
<HTML>
<HEAD>
<TITLE>CLWB/Check Message</TITLE>
</HEAD>
<BODY BGCOLOR=\"#CCFFCC\">
EOF
#
   unless($name)
      {print "<H1>*** Error: No Name ***</H1>\n";}
   unless($message)
      {print "<H1>*** Error: No Message ***</H1>\n";}
#
   print "<PRE>";
   if($owner_mode){print "Owner mode : 1(yes)\n";}
   if($to)        {print "Comment to : message #$to\n";}
   print <<EOF;
Name       : $name
URL        : $url
Mail       : $mail
Title      : $title
Message    :
$message
</PRE>
<TABLE>
<TR>
EOF
if($name && $message)
   {
   print <<EOF;
<TD>
<FORM ACTION=\"$addmsg_cgi\" METHOD=\"POST\">
<INPUT TYPE=hidden NAME=\"owner_mode\" VALUE=\"$owner_mode\">
<INPUT TYPE=hidden NAME=\"to\" VALUE=\"$to\">
<INPUT TYPE=hidden NAME=\"name\" VALUE=\"$name\">
<INPUT TYPE=hidden NAME=\"url\" VALUE=\"$url\">
<INPUT TYPE=hidden NAME=\"mail\" VALUE=\"$mail\">
<INPUT TYPE=hidden NAME=\"title\" VALUE=\"$title\">
<INPUT TYPE=hidden NAME=\"message\" VALUE=\"$message\">
<INPUT TYPE=submit VALUE=\"Send\">
</FORM>
</TD>
EOF
   }
print <<EOF;
<TD>
<FORM ACTION=\"$commsg_cgi\" METHOD=\"POST\">
<INPUT TYPE=hidden NAME=\"owner_mode\" VALUE=\"$owner_mode\">
<INPUT TYPE=hidden NAME=\"to\" VALUE=\"$to\">
<INPUT TYPE=hidden NAME=\"name\" VALUE=\"$name\">
<INPUT TYPE=hidden NAME=\"url\" VALUE=\"$url\">
<INPUT TYPE=hidden NAME=\"mail\" VALUE=\"$mail\">
<INPUT TYPE=hidden NAME=\"title\" VALUE=\"$title\">
<INPUT TYPE=hidden NAME=\"message\" VALUE=\"$message\">
<INPUT TYPE=submit VALUE=\"Modify Input Data\">
</FORM>
</TD>
</TR>
</TABLE>
Note (1): Maximum message length is $msg_limit (bytes).<BR>
Note (2): Please use reload button of browser if your message or title 
is not shown on message page or title page.<BR>
Note (3): If length of line is greater than $line_limit bytes, line is 
wrapped by CLWB.<BR>
<HR>
<CENTER>
[<A HREF=\"$clwb_cgi\">Back to CLWD titles page</A>]
[<A HREF=\"$home_url\">Back to Home Page</A>]
</CENTER>
</BODY>
</HTML>
EOF
#
   exit 0;
#
# SUBROUTINE wrap
#
sub wrap
{
   local(*msg, $limit, $code) = @_;
#
#  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.
#
   if($code eq 'sjis')
      {
      $jc = '[\201-\237\340-\374][\100-\176\200-\374]'; # Shift JIS code
      }
   else
      {
      $jc = '[\241-\376][\241-\376]'; # EUC code
      }
#  If code is JIS, message is converted to EUC in this subroutine.
   if($code eq 'jis'){&jcode'convert(*msg, 'euc', 'jis');}
#
#(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);
   if($code eq 'jis'){&jcode'convert(*msg, 'jis', 'euc');} # Reconvert
   $iline; # Return number of lines in new $msg.
}
sub error_message
   {
   local($message) = @_;
   print "Error Message from checkmsg.cgi of Web page: \n";
   print "$message\n";
   exit 1;
   }