##---------------------------------------------------------------------------##
##  File:
##      $Id: mhthread.pl,v 2.13 2011/01/02 10:14:13 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##      Thread routines for MHonArc
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1995-2001	Earl Hood, mhonarc@mhonarc.org
##
##    This program is free software; you can redistribute it and/or modify
##    it under the terms of the GNU General Public License as published by
##    the Free Software Foundation; either version 2 of the License, or
##    (at your option) any later version.
##
##    This program is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY; without even the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##    GNU General Public License for more details.
##
##    You should have received a copy of the GNU General Public License
##    along with this program; if not, write to the Free Software
##    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##    02111-1307, USA
##---------------------------------------------------------------------------##

package mhonarc;

##---------------------------------------------------------------------------
##	write_thread_index outputs the thread index
##
sub write_thread_index {
    local($onlypg) = shift;
    local($tmpl, $handle);
    local($index) = ("");
    local(*a);
    local($PageNum, $PageSize, $totalpgs, %Printed);
    local($lastlevel, $tlevel, $iscont, $i, $offstart, $offend);
    my($tmpfile);

    local($level) = 0;  	## !!!Used in print_thread!!!
    local($last0index) = '';

    ## Make sure list orders are set
    if (!scalar(@TListOrder)) {
	&compute_threads();
    }
    if (!scalar(@MListOrder)) {	# need for resource variable expansions
	@MListOrder = &sort_messages();
	%Index2MLoc = ();
	@Index2MLoc{@MListOrder} = (0 .. $#MListOrder);
    }

    &compute_page_total();
    @ThreadList = @TListOrder;
    $PageNum  = $onlypg || 1;
    $totalpgs = $onlypg || $NumOfPrintedPages;
 
    for ( ; $PageNum <= $totalpgs; ++$PageNum) {
	next  if $PageNum < $TIdxMinPg;

	if ($MULTIIDX) {
	    $offstart = ($PageNum-1) * $IDXSIZE;
	    $offend   = $offstart + $IDXSIZE-1;
	    $offend   = $#TListOrder  if $#TListOrder < $offend;
	    @a        = @TListOrder[$offstart..$offend];

	    if ($PageNum > 1) {
		$TIDXPATHNAME = join("", $OUTDIR, $DIRSEP,
				     $TIDXPREFIX, $PageNum, ".", $HtmlExt);
	    } else {
		$TIDXPATHNAME = join($DIRSEP, $OUTDIR, $TIDXNAME);
	    }

	} else {
	    $TIDXPATHNAME = join($DIRSEP, $OUTDIR, $TIDXNAME);
	    if ($IDXSIZE && (($i = ($#ThreadList+1) - $IDXSIZE) > 0)) {
		if ($TREVERSE) {
		    @NotIdxThreadList = splice(@ThreadList, $IDXSIZE);
		} else {
		    @NotIdxThreadList = splice(@ThreadList, 0, $i);
		}
	    }
	    *a = *ThreadList;
	}
	$PageSize = scalar(@a);

	if ($IDXONLY) {
	    $handle = \*STDOUT;
	} else {
	    ($handle, $tmpfile) = file_temp('tidxXXXXXXXXXX', $OUTDIR);
	}
	print STDOUT "Writing $TIDXPATHNAME ...\n"  unless $QUIET;

	$tmpl = ($TIDXPGSSMARKUP ne '') ? $TIDXPGSSMARKUP : $SSMARKUP;
	if ($tmpl ne '') {
	    $tmpl =~ s/$VarExp/&replace_li_var($1,'')/geo;
	    print $handle $tmpl;
	}

	print $handle "<!-- ", &commentize("MHonArc v$VERSION"), " -->\n";

	($tmpl = $TIDXPGBEG) =~ s/$VarExp/&replace_li_var($1,'')/geo;
	print $handle $tmpl;

	($tmpl = $THEAD) =~ s/$VarExp/&replace_li_var($1,'')/geo;
	print $handle $tmpl;

	## Flag visible messages for use in printing thread index page
	foreach $index (@a) { $TVisible{$index} = 1; }

	## Print index.  Print unless message has been printed, or
	## unless it has reference that is visible.
	$level = 0;		# !!!Used in print_thread!!!
	$lastlevel = $ThreadLevel{$a[0]};

	# check if continuing a thread
	if ($lastlevel > 0) {
	    ($tmpl = $TCONTBEG) =~ s/$VarExp/&replace_li_var($1,$a[0])/geo;
	    print $handle $tmpl;
	}
	# perform any indenting
	for ($i=0; $i < $lastlevel; ++$i) {
	    ++$level;
	    if ($level <= $TLEVELS) {
		($tmpl = $TINDENTBEG) =~ s/$VarExp/&replace_li_var($1,'')/geo;
		print $handle $tmpl;
	    }
	}
	# print index listing
	foreach $index (@a) {
	    $tlevel = $ThreadLevel{$index};
	    if (($lastlevel > 0) && ($tlevel < $lastlevel)) {
		for ($i=$tlevel; $i < $lastlevel; ++$i) {
		    if ($level <= $TLEVELS) {
			($tmpl = $TINDENTEND) =~
			    s/$VarExp/&replace_li_var($1,'')/geo;
			print $handle $tmpl;
		    }
		    --$level;
		}
		$lastlevel = $tlevel;
		if ($lastlevel < 1) {	# Check if continuation done
		    ($tmpl = $TCONTEND) =~
			s/$VarExp/&replace_li_var($1,'')/geo;
		    print $handle $tmpl;
		}
	    }
	    unless ($Printed{$index} ||
		    ($HasRef{$index} && $TVisible{$HasRef{$index}})) {
		&print_thread($handle, $index,
			      ($lastlevel > 0) ? 0 : 1);
	    }
	}
	# unindent if required
	for ($i=0; $i < $lastlevel; ++$i) {
	    if ($level <= $TLEVELS) {
		($tmpl = $TINDENTEND) =~ s/$VarExp/&replace_li_var($1,'')/geo;
		print $handle $tmpl;
	    }
	    --$level;
	}
	# close continuation if required
	if ($lastlevel > 0) {
	    ($tmpl = $TCONTEND) =~ s/$VarExp/&replace_li_var($1,'')/geo;
	    print $handle $tmpl;
	}

	## Reset visibility flags
	foreach $index (@a) { $TVisible{$index} = 0; }

	($tmpl = $TFOOT) =~ s/$VarExp/&replace_li_var($1,'')/geo;
	print $handle $tmpl;

	&output_doclink($handle);

	($tmpl = $TIDXPGEND) =~ s/$VarExp/&replace_li_var($1,'')/geo;
	print $handle $tmpl;

	print $handle "<!-- ", &commentize("MHonArc v$VERSION"), " -->\n";

	if (!$IDXONLY) {
	    close($handle);
	    file_gzip($tmpfile)  if $GzipFiles;
	    file_chmod(file_rename($tmpfile, $TIDXPATHNAME));
	}
    }
}

##---------------------------------------------------------------------------
##	Routine to compute the order messages are listed by thread.
##	Main use is to provide the ability to correctly define
##	values for resource variables related to next/prev thread
##	message.
##
##	NOTE: Thread order is determined by all the messages in an
##	archive, and not by what is visible in the thread index page.
##	Hence, if the thread index page size is less than number of
##	messages, the next/prev messages of thread (accessible via
##	resource variables) will not necessarily correspond to the
##	actual physical next/prev message listed in the thread index.
##	
##	The call to do_thread() defines the TListOrder array for use
##	in expanding thread related resource variables.
##
sub compute_threads {
    local(%FirstSub2Index) = ();
    local(%Counted) = ();
    local(%stripsub) = ();
    local(@refs);
    local($index, $msgid, $refindex, $depth, $tmp);

    ##	Reset key data structures
    @TListOrder  = ();
    %Index2TLoc  = ();
    %ThreadLevel = ();
    %HasRef	 = ();
    %HasRefDepth = ();
    %Replies 	 = ();
    %SReplies 	 = ();

    ##	Sort by date first for subject based threads
    @ThreadList = sort_messages(0,0,0,0);

    ##	Find first occurrances of subjects
    if (!$NoSubjectThreads) {
	foreach $index (@ThreadList) {
	    $tmp = lc $Subject{$index};
	    1 while (($tmp =~ s/^$SubReplyRxp//io) ||
		     ($tmp =~ s/\s*-\s*re(ply|sponse)\s*$//io));

	    $stripsub{$index} = $tmp;
	    next  unless $tmp =~ /\S/;
	    $FirstSub2Index{$tmp} = $index
		unless defined($FirstSub2Index{$tmp}) ||
		       (defined($Refs{$index}) &&
			grep($MsgId{$_}, @{$Refs{$index}}));
	}
    }

    ##	Compute thread data
    TCOMP: foreach $index (@ThreadList) {
	next  unless defined($Refs{$index});

	# Check for explicit threading
	if (@refs = @{$Refs{$index}}) {
	    $depth = 0;
	    while ($msgid = pop(@refs)) {
		if (($refindex = $MsgId{$msgid})) {

		    $HasRef{$index} = $refindex;
		    $HasRefDepth{$index} = $depth;
		    if ($Replies{$refindex}) {
			push(@{$Replies{$refindex}}, $index);
		    } else {
			$Replies{$refindex} = [ $index ];
		    }
		    next TCOMP;
		}
		++$depth;
	    }
	}

    } continue {
	# Check for subject-based threading
	if (!$NoSubjectThreads && !$HasRef{$index}) {
	    $refindex = $FirstSub2Index{$stripsub{$index}};
	    if ($refindex && ($refindex ne $index)) {

		$HasRef{$index} = $refindex;
		$HasRefDepth{$index} = 0;
		if ($SReplies{$refindex}) {
		    push(@{$SReplies{$refindex}}, $index);
		} else {
		    $SReplies{$refindex} = [ $index ];
		}
	    }
	}
    }

    ## Calculate thread listing order
    @ThreadList = sort_messages($TNOSORT, $TSUBSORT, 0, $TREVERSE);
    foreach $index (@ThreadList) {
	unless ($Counted{$index} || $HasRef{$index}) {
	    &do_thread($index, 0);
	}
    }
}

##---------------------------------------------------------------------------
##	do_thread() computes the order messages are listed by thread.
##	Uses %Counted defined locally in compute_thread_from_list().
##	do_thread() main purpose is to set the TListOrder array and
##	Index2TLoc assoc array.
##
sub do_thread {
    local($idx, $level) = ($_[0], $_[1]);
    local(@repls, @srepls) = ();

    ## Get replies
    @repls  = sort increase_index @{$Replies{$idx}}
	if defined($Replies{$idx});
    @srepls = sort increase_index @{$SReplies{$idx}}
	if defined($SReplies{$idx});

    ## Add index to printed order list (IMPORTANT SIDE-EFFECT)
    push(@TListOrder, $idx);
    $Index2TLoc{$idx} = $#TListOrder;

    ## Mark message
    $Counted{$idx} = 1;
    $ThreadLevel{$idx} = $level;

    if (@repls) {
	foreach (@repls) {
	    &do_thread($_, $level + 1 + $HasRefDepth{$_});
	}
    }
    if (@srepls) {
	foreach (@srepls) {
	    &do_thread($_, $level + 1 + $HasRefDepth{$_});
	}
    }
}

##---------------------------------------------------------------------------
##	Routine to print thread.
##	Uses %Printed defined by caller.
##
sub print_thread {
    local($handle, $idx, $top) = ($_[0], $_[1], $_[2]);
    my(@repls, @srepls) = ();
    my($attop, $haverepls, $hvnirepls, $single, $depth, $i);
    my $didtliend = 0;

    ## Get replies
    @repls  = sort increase_index @{$Replies{$idx}}
	if defined($Replies{$idx});
    @srepls = sort increase_index @{$SReplies{$idx}}
	if defined($SReplies{$idx});
    $depth  = $HasRefDepth{$idx};
    $hvnirepls = (@repls || @srepls);

    @repls  = grep($TVisible{$_}, @repls);
    @srepls = grep($TVisible{$_}, @srepls);
    $haverepls = (@repls || @srepls);

    ## $hvnirepls is a flag if the message has replies, but they are
    ## not visible.  $haverepls is a flag if the message has visible
    ## replies.  $hvnirepls is used to determine the $attop and
    ## $single flags.  $haverepls is used for determine recursive
    ## calls and level.

    ## Print entry
    #$attop  = ($top && $haverepls);
    #$single = ($top && !$haverepls);
    $attop   = ($top && $hvnirepls);
    $single  = ($top && !$hvnirepls);

    if ($attop) {
	&print_thread_var($handle, $idx, \$TTOPBEG);
    } elsif ($single) {
	&print_thread_var($handle, $idx, \$TSINGLETXT);
    } else {
	## Check for missing messages
	if ($DoMissingMsgs) {
	    for ($i=$depth; $i > 0; --$i) {
		++$level;
		&print_thread_var($handle, $idx, \$TLINONE);
		&print_thread_var($handle, $idx, \$TSUBLISTBEG)
		    if $level <= $TLEVELS;
	    }
	}
	&print_thread_var($handle, $idx, \$TLITXT);
    }

    ## Increment level count if their are replies
    ++$level  if ($haverepls);

    ## Print list item close if hit max depth
    if (!$attop && !$single && ($level > $TLEVELS)) {
	&print_thread_var($handle, $idx, \$TLIEND);
	$didtliend = 1;
    }

    ## Mark message printed
    $Printed{$idx} = 1;

    ## Print sub-threads
    if (scalar(@repls) || scalar(@srepls)) {
	&print_thread_var($handle, $idx, \$TSUBLISTBEG)  if $level <= $TLEVELS;
	foreach (@repls) {
	    &print_thread($handle, $_);
	}
	if (@srepls) {
	    &print_thread_var($handle, $idx, \$TSUBJECTBEG);
	    foreach (@srepls) {
		&print_thread($handle, $_);
	    }
	    &print_thread_var($handle, $idx, \$TSUBJECTEND);
	}
	&print_thread_var($handle, $idx, \$TSUBLISTEND)  if $level <= $TLEVELS;
    }

    ## Decrement level count if their were replies
    --$level  if ($haverepls);

    ## Check for missing messages
    if ($DoMissingMsgs && !($attop || $single)) {
	for ($i=$depth; $i > 0; --$i) {
	    &print_thread_var($handle, $idx, \$TSUBLISTEND)
		if $level <= $TLEVELS;
	    &print_thread_var($handle, $idx, \$TLINONEEND);
	    --$level;
	}
    }

    ## Close entry text
    if ($attop) {
	&print_thread_var($handle, $idx, \$TTOPEND);
    } elsif (!$single && !$didtliend) {
	&print_thread_var($handle, $idx, \$TLIEND);
    }
}

##---------------------------------------------------------------------------
##	Print out text based upon resource variable referenced by $tvar.
##
sub print_thread_var {
    my($handle, $index, $tvar) = @_;
    my($tmpl);
    ($tmpl = $$tvar) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
    print $handle $tmpl;
}

##---------------------------------------------------------------------------
##	make_thread_slice generates a slice of the thread listing.
##	Arguments are:
##
##	    $refindex	: Reference message index that slice is based
##	    $bcnt	: Number of messages before $refindex to list
##	    $acnt	: Number of messages after $refindex to list
##
##	Returns string containing thread slice text.
##
sub make_thread_slice {
    my($refindex, $bcnt, $acnt, $inclusive) = @_;
    my($slicetxt) = "";

    my($pos)   = $Index2TLoc{$refindex};
    my($start) = $pos - $bcnt;
    my($end)   = $pos + $acnt;
    $start     = 0             if $start < 0;
    $end       = $#TListOrder  if $end > $#TListOrder;
    if ($inclusive) {
	# adjust before count
	if ($bcnt == 0 || $ThreadLevel{$TListOrder[$pos]} <= 0) {
	    $start = $pos;
	} else {
	    for ($i=$pos-1; ($i > $start) && ($i > 0); --$i) {
		last  if ($ThreadLevel{$TListOrder[$i]} <= 0);
	    }
	    $start = $i;
	}
	# adjust after count
	if ($acnt != 0) {
	    for ($i=$pos+1; ($i <= $end) && ($i <= $#TListOrder); ++$i) {
		last  if ($ThreadLevel{$TListOrder[$i]} <= 0);
	    }
	    $end = $i-1;
	}

    }
    my(@a)         = @TListOrder[$start..$end];
    my($lastlevel) = $ThreadLevel{$a[0]};
    my($tmpl, $index, $tlevel, $iscont, $i);

    local($level)     = 0;  	## XXX: Used in make_thread!!!
    local(%Printed)   = ();	## XXX: Used in make_thread!!!

    ($tmpl = $TSLICEBEG) =~ s/$VarExp/&replace_li_var($1,'')/geo;
    $slicetxt .= $tmpl;

    ## Flag visible messages for use in printing thread
    foreach $index (@a) { $TVisible{$index} = 1; }

    # check if continuing a thread
    if ($lastlevel > 0) {
	($tmpl = $TSLICECONTBEG) =~ s/$VarExp/&replace_li_var($1,$a[0])/geo;
	$slicetxt .= $tmpl;
    }
    # perform any indenting
    for ($i=0; $i < $lastlevel; ++$i) {
	++$level;
	if ($level <= $TSLICELEVELS) {
	    ($tmpl = $TSLICEINDENTBEG) =~ s/$VarExp/&replace_li_var($1,'')/geo;
	    $slicetxt .= $tmpl;
	}
    }
    # print index listing
    foreach $index (@a) {
	$tlevel = $ThreadLevel{$index};
	if (($lastlevel > 0) && ($tlevel < $lastlevel)) {
	    for ($i=$tlevel; $i < $lastlevel; ++$i) {
		if ($level <= $TSLICELEVELS) {
		    ($tmpl = $TSLICEINDENTEND) =~
			s/$VarExp/&replace_li_var($1,'')/geo;
		    $slicetxt .= $tmpl;
		}
		--$level;
	    }
	    $lastlevel = $tlevel;
	    if ($lastlevel < 1) {	# Check if continuation done
		($tmpl = $TSLICECONTEND) =~
		    s/$VarExp/&replace_li_var($1,'')/geo;
		$slicetxt .= $tmpl;
	    }
	}
	unless ($Printed{$index} ||
		($HasRef{$index} && $TVisible{$HasRef{$index}})) {
	    $slicetxt .= &make_thread($index,
			      (($lastlevel > 0) ? 0 : 1), $refindex);
	}
    }
    # unindent if required
    for ($i=0; $i < $lastlevel; ++$i) {
	if ($level <= $TSLICELEVELS) {
	    ($tmpl = $TSLICEINDENTEND) =~ s/$VarExp/&replace_li_var($1,'')/geo;
	    $slicetxt .= $tmpl;
	}
	--$level;
    }
    # close continuation if required
    if ($lastlevel > 0) {
	($tmpl = $TSLICECONTEND) =~ s/$VarExp/&replace_li_var($1,'')/geo;
	$slicetxt .= $tmpl;
    }

    ## Reset visibility flags
    foreach $index (@a) { $TVisible{$index} = 0; }

    ($tmpl = $TSLICEEND) =~ s/$VarExp/&replace_li_var($1,'')/geo;
    $slicetxt .= $tmpl;

    $slicetxt;
}

##---------------------------------------------------------------------------
##	Routine to generate text representing a thread.
##	Used by make_thread_slice().
##	Uses %Printed and $level defined by caller.
##
sub make_thread {
    my($idx, $top, $refidx) = @_;
    my($attop, $haverepls, $hvnirepls, $single, $depth, $i);
    my(@repls, @srepls) = ( );
    my($ret) = "";

    ## Get replies
    @repls  = sort increase_index @{$Replies{$idx}}
	if defined($Replies{$idx});
    @srepls = sort increase_index @{$SReplies{$idx}}
	if defined($SReplies{$idx});
    $depth  = $HasRefDepth{$idx};
    $hvnirepls = (@repls || @srepls);

    @repls  = grep($TVisible{$_}, @repls);
    @srepls = grep($TVisible{$_}, @srepls);
    $haverepls = (@repls || @srepls);

    ## $hvnirepls is a flag if the message has replies, but they are
    ## not visible.  $haverepls is a flag if the message has visible
    ## replies.  $hvnirepls is used to determine the $attop and
    ## $single flags.  $haverepls is used for determine recursive
    ## calls and level.

    ## Print entry
    $attop   = ($top && $hvnirepls);
    $single  = ($top && !$hvnirepls);

    if ($attop) {
	$ret .= &expand_thread_var($idx,
		  ($idx eq $refidx) ? \$TSLICETOPBEGCUR : \$TSLICETOPBEG);
    } elsif ($single) {
	$ret .= &expand_thread_var($idx,
		  ($idx eq $refidx) ? \$TSLICESINGLETXTCUR: \$TSLICESINGLETXT);
    } else {
	## Check for missing messages
	if ($DoMissingMsgs) {
	    for ($i = $depth; $i > 0; $i--) {
		$level++;
		$ret .= &expand_thread_var($idx, \$TSLICELINONE);
		$ret .= &expand_thread_var($idx, \$TSLICESUBLISTBEG)
		    if $level <= $TSLICELEVELS;
	    }
	}
	$ret .= &expand_thread_var($idx,
		  ($idx eq $refidx) ? \$TSLICELITXTCUR : \$TSLICELITXT);
    }

    ## Increment level count if their are replies
    if ($haverepls) {
	$level++;
    }

    ## Mark message printed
    $Printed{$idx} = 1;

    ## Print sub-threads
    if (@repls) {
	$ret .= &expand_thread_var($idx, \$TSLICESUBLISTBEG)
	    if $level <= $TSLICELEVELS;
	foreach (@repls) {
	    $ret .= &make_thread($_, 0, $refidx);
	}
	$ret .= &expand_thread_var($idx, \$TSLICESUBLISTEND)
	    if $level <= $TSLICELEVELS;
    }
    if (@srepls) {
	$ret .= &expand_thread_var($idx, \$TSLICESUBLISTBEG)
	    if $level <= $TSLICELEVELS;
	$ret .= &expand_thread_var($idx, \$TSLICESUBJECTBEG);
	foreach (@srepls) {
	    $ret .= &make_thread($_, 0, $refidx);
	}
	$ret .= &expand_thread_var($idx, \$TSLICESUBJECTEND);
	$ret .= &expand_thread_var($idx, \$TSLICESUBLISTEND)
	    if $level <= $TSLICELEVELS;
    }

    ## Decrement level count if their were replies
    if ($haverepls) {
	$level--;
    }
    ## Check for missing messages
    if ($DoMissingMsgs && !($attop || $single)) {
	for ($i = $depth; $i > 0; $i--) {
	    $ret .= &expand_thread_var($idx, \$TSLICESUBLISTEND)
		if $level <= $TSLICELEVELS;
	    $ret .= &expand_thread_var($idx, \$TSLICELINONEEND);
	    $level--;
	}
    }

    ## Close entry text
    if ($attop) {
	$ret .= &expand_thread_var($idx,
		  ($idx eq $refidx) ? \$TSLICETOPENDCUR : \$TSLICETOPEND);
    } elsif (!$single) {
	$ret .= &expand_thread_var($idx,
		  ($idx eq $refidx) ? \$TSLICELIENDCUR : \$TSLICELIEND);
    }

    $ret;
}

##---------------------------------------------------------------------------
##	Expand text based upon resource variable referenced by $tvar.
##
sub expand_thread_var {
    my($index, $tvar) = @_;
    my($expstr);
    ($expstr = $$tvar) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
    $expstr;
}

##---------------------------------------------------------------------------
1;