#! /usr/local/bin/perl

=comment
̓XNvgptree\XNvg ver0.9 (03/05/12)


-- ͉ł? --

̓XNvg̋Lc[^ɕ\邽߂̃W[łB



-- gp@ --

̃t@CsubtH_ɒuA
bbs.cgi1400sڕt߂ȉ̂悤ɂ܂B

# tree\
if ($FORM{'tree'}) {
	require './ks_treeview.pl';
	$prtmessage = output_treeview($bmsg, $msgtop);
}

bbs.cgi?tree=on treeviewp̕\ł܂B
=cut




###############################################################################
#  ݒ
###############################################################################

my %treeview = (

  # V̋L̐F
  'newmsg_color' => 'aaddff',

  # }̐F
  'branch_color' => '005050',

);


###############################################################################
#  c[^ŏo͂邽߂̊֐
###############################################################################
# @logdata, %logdata, %kids, ̓O[oϐ


# $headڂ $tailڂ̃c[o͂
sub output_treeview
{
	my ($head, $tail) = @_;
	my $output;

	%logdata		= make_hash_logdata(@logdata);
	%kids			= make_kids(@logdata);
	my @threadID	= get_threadID(@logdata);

	@threadID = map {$_->[0]} sort {$b->[1] <=> $a->[1]} map { [ $_ => max_postID($_) ] } @threadID;
	
	$tail = $#threadID >= $tail ? $tail : $#threadID;
	@threadID = @threadID[$head .. $tail];

	for my $threadID (@threadID) {
		my $max_postID = max_postID($threadID);
		my $ndate = (split m|,|, $logdata{$max_postID})[0];		

		my @tmp = enum_postID($threadID);
		my $count = @tmp;

		$output .= qq|<tt><font size="+0">@<a href="?m=t&s=$threadID"></a>$count [ XVF@{[ getnowdate($ndate) ]} ]</font></tt><br><br>|;
		@header = ('@');

		$output .= output_tree($threadID);
		$output .= "<hr>\n";
	}
	return $output;
}

# 1̃c[o͂
sub output_tree
{
	my $node = shift;
	my $output = '';

	# o
	$output .= output_node($node);

	# qȂ
	if (q_article($node, 'has_child')) {
		for my $node (@{ $kids{$node} }) { $output .= output_tree($node) }
		pop @header;
	}
	return $output;
}


# 1̃m[ho͂
sub output_node
{
	my $node = shift;

	my ($ndate, $postid, $protect, $thread, $phost, $agent, $user, $mail, $title, $msg) = split(m|,|, $logdata{$node});
	my $res_button = "<a href='?m=f&s=$postid'></a>";

	if ($user ne '' and $user and ' ' and $user ne '@') { 
		$msg = "e: $user\0".$msg;
	}

	$_ = $msg;

	s|[\n\r]|\0|g;

	# 2O̕ԐM
	s|&gt; &gt;.*?\0\0?||g;

	# 1O̕ԐM
	my $pre_msg;	# 1O̕ԐM
	if (s|(&gt;.*?)\0\0||g) { $pre_msg = $1; }

	# Ql
	s|<A href=[^>]*?>QlF[^>]*?</A>||g;

	# e̘Asg~O
	s|[\0]{2,}$|\0|g;

	# L
	my $article = $_;
	$article =~ s/\0//g;
	$article =~ s/\s//g;

	q_article($node, 'is_last')
		? push @header, "<font color='#$treeview{branch_color}'>$res_button</font>"
		: push @header, "<font color='#$treeview{branch_color}'>$res_button</font>";

	q_article($node, 'is_root')  and  $header[-1] = "<font color='#$treeview{branch_color}'>&nbsp;&nbsp;$res_button</font>";

	my $head = join '', @header;
	pop @header;

	if (q_article($node, 'has_child') and q_article($node, 'is_last')) {
		push @header, "<font color='#$treeview{branch_color}'>@</font>";
	} elsif (q_article($node, 'has_child') and not q_article($node, 'is_last')) {
		push @header, "<font color='#$treeview{branch_color}'></font>";	
	} elsif (not q_article($node, 'has_child') and q_article($node, 'is_last')) {
		push @header, "<font color='#$treeview{branch_color}'>@@</font>";
	} elsif (not q_article($node, 'has_child') and not q_article($node, 'is_last')) {
		push @header, "<font color='#$treeview{branch_color}'>@</font>";
	}


	my $body = join '', @header;
	s|\0|<br>\n$body|g;


	# qȂ玩̓''ɕς
	q_article($node, 'has_child')  and  $header[-1] = "<font color='#$treeview{branch_color}'></font>";

	# ̎qȂ玩̓'@'ɕς
	q_article($node, 'is_last')  and  $header[-1] = '@';

	# qȂȂ|bv
	not q_article($node, 'has_child')  and  pop @header;

	# VLȂFς
	my $msgcolor = (defined $FORM{p} and $postid > $FORM{p}) ? $treeview{newmsg_color} : 'ffffff';

	if ($article eq '') { 
		$pre_msg =~ s|\0|<br>\n$body|g;
		$head .= $pre_msg;
	}
	return qq(\n<tt><font size="+0" color="#$msgcolor">\n$head$_<br>\n</font></tt>\n);
}

# e₢킹
sub q_article
{
	my ($ID, $query) = @_;

	# is_root
	# is_dummy
	# get_parentID
	# is_last
	# has_child

	if ($query eq 'is_root') {
		return ( split m|,|, $logdata{$ID} )[3] ? 0 : 1;
	} elsif ($query eq 'is_dummy') {
		return ( split m|,|, $logdata{$ID} )[0];
	} elsif ($query eq 'has_child') {
		return defined $kids{$ID}
	} elsif ($query eq 'is_last') {
		my ($ndate, $postid, $protect, $thread, $phost, $agent, $user, $mail, $title, $msg) = split m|,|, $logdata{$ID};

		# [gȂreturn
		if (not $thread) { return 1 }

		my $parent = q_article($ID, 'get_parentID');
		if ($parent and $logdata{$parent}) {
			return ${ $kids{$parent} }[-1] == $ID ? 1 : 0;
		} else {
			my ($ndate, $postid, $protect, $thread, $phost, $agent, $user, $mail, $title, $msg) = split m|,|, $logdata{$ID};
			return ${ $kids{$thread} }[-1] == $ID ? 1 : 0;
		}
	} elsif ($query eq 'get_parentID') {
		my ($ndate, $postid, $protect, $thread, $phost, $agent, $user, $mail, $title, $msg) = split m|,|, $logdata{$ID};
		$msg =~ m|<A href=".*?&s=(\d*)[^>]*?>Ql|i ?  return $1 : return undef;
#		$msg =~ m|<A href="m=f&s=(\d*)[^>]*?>Ql|i ?  return $1 : return undef;
	}

}

sub max_postID { ( sort {$b <=> $a} enum_postID($_[0]) )[0] }

# postid => article
sub make_hash_logdata {  map { my $log = $_; (split m|,|, $log)[1] => $log } @_  }

# parent_postid =>[child_postid, child_postid, ... ]
sub make_kids
{
	my @logdata = @_;
	my %kids;

	for (reverse @logdata) {
		my ($ndate, $postid, $protect, $thread, $phost, $agent, $user, $mail, $title, $msg) = split m|,|;
		my $parent_postid = q_article($postid, 'get_parentID');

		if (not exists $logdata{$thread}) { 
		# [g݂Ȃꍇ
		# 
		# _~[̃[g쐬
		# ̎qƂēo^
		# 
			$logdata{$thread} = make_dummy_article($thread);
			push @{ $kids{$thread} }, $postid;
		} elsif (q_article($thread, 'is_dummy') == -1) {
		# _~[[g݂ꍇ
		# : -1TRUE
			if ($logdata{$parent_postid}) {
				push @{ $kids{$parent_postid} }, $postid;
			} else {
				push @{ $kids{$thread} }, $postid;
			}
		} elsif ($logdata{$thread}) {
		# [g݂ꍇ
		# 
			push @{ $kids{$parent_postid} }, $postid;
		}
	}
	return %kids;
}


# LȂƂ̃_~[L񋟂
sub make_dummy_article {  "-1,$_[0],,,,,,,,== not_found ==\n"  }

# thread => [postid, postid, .. ]
sub get_threadID
{
	my @logdata = @_;
	my @threadID;

	for (@logdata) {
		my ($ndate, $postid, $protect, $thread, $phost, $agent, $user, $mail, $title, $msg) = split m|,|;
		$thread  ?  push @threadID, $thread
				 :  push @threadID, $postid;
	}

	# @threadIDdvf폜
	return keys %{ { map {$_ => 1} @threadID} };
}



sub enum_postID
{
	my $ID = shift;
	my @postID = ($ID);

	if (q_article($ID, 'has_child')) {
		for my $kid (@{ $kids{$ID} }) {
			push @postID, enum_postID($kid);
		}
	}

	return @postID;
}


1;