#! /srvtools/http/bin/perl
#############################################################################
#  
#   File:          ReadBoard.pl
#
#   Authors:       Paul Coddington and Jungmin Kim
#
#   Version:       09-May-96
#
#   Input:         path name, file name, user information, subdirectory
#                    ($path, $file, $user, $subdir)
#   Output:        HTML text listing the messages for a particular topic.  
#
#   Description:   Print out headers of messages for a particular conference
#                   (given by the path and specified files). 
#                  Function PrintHeader is for printing headers. 
#                  Function PrintFile is for printing messages.
#                  Function dotorder sorts file names in hierachical numbering
#                   order.
#               
#   Usage:         "http://..../WeBBoard/read:path:filename:user"
#   Usage:         "http://..../WeBBoard/read:path:filename::user" ??
#
#   05-Mar-95      Initial version by Jungmin Kim.
#   25-Apr-96      Compressed the display a bit.
#   09-May-96      Compressed the display some more took out email address).
#
#   To Do:         'user' should be "username:email_address".
#
#############################################################################

require "CheckPasswd.pl";
require "PrintHeader.pl";
require "PrintHeader2.pl";
require "PrintFile.pl";
require "Address.pl";

sub ReadBoard{

    local($path, $file, $user, $subdir) = @_;
    local($pathname);
    local($prev, $next, @entry, %array, $d, $t, $n, $message);
    local($oldm, $oldn, $oldd, $oldt);
    local(%messages, %titles, %dates, %names);
    
    $pathname = $conference{$path};

    print "Content-type\: text/html\n\n";
    print "\n";
    print "<HTML>\n";
    print "<HEAD>\n";
    print "<TITLE> Read messages for the forum $pathname </TITLE>\n";
    print "</HEAD>\n";
    print "<H2>$pathname</H2>\n";
	
    print "<HR>\n";
    # explain icon for adding new message
    print "<IMG SRC=\"$gif/new-pencil.gif\" ALIGN=\"left\" ALT=\"\">";
    # Ideally this would be in italics but italics look terrible on
    #  Netscape for the Mac
    print "Click on this icon, which appears next to each message, <BR>\n";
    print "to respond to that message or post a new message. \n";

    print "<HR>\n";

    #### array for file names to be printed
    %array = ();

    #### print out all headers of messages in directory $path in numerical
    #### order
    print "<A NAME = subject>\n";
    print "<B>List of messages ordered by subject</B></A>\n";
    print "(or <A HREF=\"$action/$subdir\:readtime\:$path\:$file\:$user\">\n";
    print "<B>List messages ordered by time</B></A>)\n";
    &PrintHeader2($path, $file, $user, $subdir,*array);
    print "<HR>\n";
    print "<HR>\n";

     &PrintMessages($path, $file, $user, $subdir, %array);
}
1;
 

sub ReadTime{

    local($path, $file, $user, $subdir) = @_;
    local($pathname);
    local($prev, $next, @entry, %array, $d, $t, $n, $message);
    local($oldm, $oldn, $oldd, $oldt);
    local(%messages, %titles, %dates, %names);
    
    $pathname = $conference{$path};

    print "Content-type\: text/html\n\n";
    print "\n";
    print "<HTML>\n";
    print "<HEAD>\n";
    print "<TITLE> Read messages for the forum $pathname </TITLE>\n";
    print "</HEAD>\n";
    print "<H2>$pathname</H2>\n";
	
    print "<HR>\n";
    # explain icon for adding new message
    print "<IMG SRC=\"$gif/new-pencil.gif\" ALIGN=\"left\" ALT=\"\">";
    # Ideally this would be in italics but italics look terrible on
    #  Netscape for the Mac
    print "Click on this icon, which appears next to each message, <BR>\n";
    print "to respond to that message or post a new message. \n";

    print "<HR>\n";

    #### array for file names to be printed
    %array = ();

    #### print out all headers of messages in directory $path in numerical
    #### order
    print "<A NAME = time>\n";
    print "<B>List of messages ordered by time</B></A>\n";
    print "(or <A HREF=\"$action/$subdir\:read\:$path\:$file\:$user\">\n";
    print "<B>List messages ordered by subject</B></A>)\n";
    &PrintHeader($path, $file, $user, $subdir,*array);
    print "<HR>\n";
    print "<HR>\n";

     &PrintMessages($path, $file, $user, $subdir, %array);
}

########################################################################
# Print out the contents of the messages
########################################################################
sub PrintMessages{
 
    local($path, $file, $user, $subdir, %array) = @_;
    local($prev, $next, @entry, $d, $t, $n, $message, $dotcount, $color);
    local($oldm, $oldn, $oldd, $oldt);
    local(%messages, %titles, %dates, %names);

    $initial = "";
    #### print messages coresponding to returned file names
    foreach $next (sort dotorder keys %array) {
	$_ = $next;

	# indentation for hierachical view
	print "<DL COMPACT>\n";
	$dotcount = 0;
	while ( /^[0-9]*\.(.*)/ ) {  # number of dots is number of tabs
	$dotcount++;
	    $_ = $1;
	    print "<DL COMPACT>\n";
	}
	if ($dotcount == 0) {
	   $color = "AA0000";
	}
	elsif ($dotcount == 1) {
	   $color = "00AA00";
	}
	else {
	   $color = "0000AA";
	}

	print "<A NAME=\"$next\">\n";

        # separator for each field is eot(\005) *************** modified
	#### split the passed string associated to the file name
        #### into date ($d), name ($n) and title ($t)
	($d, $n, $t) = split(/\005/, $array{$next});
        
        #### Get email address to go with user name
        $e = GetAddress($subdir, $n);

	$pathname = "$webboardhome\/$subdir\/$path";
	$message = &PrintFile($pathname, "$next.html");

	$oldm = $message;
	$oldt = $t;
        $oldn = $n;
	$oldd = $d;

        ### Replaces special characters such as : and +
	$d = &Replace($d);
	$n = &Replace($n);
	$t = &Replace($t);
	$message = &Replace($message);

	$initial = $1 if $next =~ /^(.+)\.([^\.]*)/;
	$initial = $next if $next =~ /^[^\.]+$/;

	$messages{$next} = $message;
	$titles{$next} = $t;
	$dates{$next} = $d;
	$names{$next} = $n;

	print "<DT>\n";

	#### if the user name is 'guest', do not activate the submit button
        if($user ne "guest") {
	    print "<A HREF=\"$action/$subdir\:post\:$path\:$next\:$user";
	    print "\?hdate=$d\&hname=$n\&htitle=$t\&hmessage=$message";
	    print "\&initial=$initial";
	    print "\&htitle2=$titles{$initial}";
	    print "\&hmessage2=$messages{$initial}";
	    print "\&hdate2=$dates{$initial}";
	    print "\&hname2=$names{$initial}\">\n";
	    print "<IMG SRC=\"$gif/new-pencil.gif\" ALIGN=BOTTOM ALT=\"REPLY\">";
	    print "</A>\n";
	}
        else {
	    # print "<IMG SRC=\"$gif/new-pencil.gif\" ALIGN=BOTTOM ALT=\"REPLY\">";
        }

        ### Print the header
	print "<FONT COLOR=\"\#$color\">";
	print "<B>";
	print "$next\: ";
	print "$oldt\n";
	print "</B>";
        print "</FONT>\n";
        print "<FONT SIZE=\"-1\">\n";
	# print "from <B>$oldn <I>(<A HREF=\"mailto:$e\">$e</A>)</I></B>\n";
        if ($e) { # If there is an email address
	   print "from <A HREF=\"mailto:$e\">$oldn</A>\n";
        }
        else {
	   print "from $oldn \n";
        }
	print "on $oldd.\n";
        print "</FONT>\n";
	print "<P>\n";

	#### Print the message
	print $oldm;
	print "<BR><HR>\n";
	# print "<P>\n";

	#### close indentation
	$_ = $next;
	while ( /^[0-9]*\.(.*)/ ) { # number of dots is number of tabs
	    $_ = $1;
	    print "</DL>\n";
	}
	print "</DL>\n";
    }
    # print "<HR>\n";
    &Address($subdir);
}
1;

#############################################################################
#
#   dotorder
#
#   INPUT:     $a, $b (system arguments passed by function sort(). )
#   OUTPUT:    greater than, less than, or equal
#
#   FUNCTION:  Compare $a and $b with hierachical numbering order, 
#              and returns -1, 0, 1.
#
#############################################################################

sub dotorder {
    $c = $a;
    $d = $b;

    for(;;){
	$c =~ s/^(\d*)(\.)*//;            # remove prefix of $a
	$e = $1;		          # copy the prefix of $a
	$d =~ s/^(\d*)(\.)*//;            # remove prefix of $b
	$f = $1;		          # copy the prefix of $b
	last if $e != $f;	          # compare prefixes of each numbers
    }
    return $e <=> $f;
}
1;

#############################################################################
#
#   Replace
#
#   INPUT:     string
#   OUTPUT:    exactly same format as 'QUERY_STRING' in 'GET' method
#
#   FUNCTION:  convert special characters to hex numbers
#
#############################################################################

sub Replace {
    local($st) = @_;
    $_ = $st;
    s/\%/%25/g;
    s/\n/%0A/g;
    s/\r/%0D/g;
    s/\t/%09/g;
    s/\!/%21/g;
    s/\"/%22/g;
    s/\#/%23/g;
    s/\$/%24/g;
    s/\&/%26/g;
    s/\'/%27/g;
    s/\(/%28/g;
    s/\)/%29/g;
    s/\+/%2B/g;
    s/\,/%2C/g;
    s/\//%2F/g;
    s/\:/%3A/g;
    s/\;/%3B/g;
    s/\</%3C/g;
    s/\=/%3D/g;
    s/\>/%3E/g;
    s/\?/%3F/g;
    s/\[/%5B/g;
    s/\\/%5C/g;
    s/\]/%5D/g;
    s/\^/%5E/g;
    s/\`/%60/g;
    s/\{/%7B/g;
    s/\|/%7C/g;
    s/\}/%7D/g;
    s/\~/%7E/g;
    s/ /\+/g;
    $_;
}
1;
