#! /usr/local/bin/perl

=comment
くずはスクリプト用のtree表示スクリプト ver0.9 (03/05/12)


-- これは何ですか? --

くずはスクリプトの記事をツリー型に表示するためのモジュールです。



-- 使用法 --

このファイルをsubフォルダに置き、
bbs.cgiの1400行目付近を以下のようにします。

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

bbs.cgi?tree=on でtreeview用の表示ができます。
=cut




###############################################################################
#  設定
###############################################################################

my %treeview = (

  # 新着の記事の色
  'newmsg_color' => 'aaddff',

  # 枝の色
  'branch_color' => '005050',

);


###############################################################################
#  ツリー型で出力するための関数
###############################################################################
# @logdata, %logdata, %kids, はグローバル変数


# $head件目から $tail件目のツリーを出力する
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 [ 更新日：@{[ getnowdate($ndate) ]} ]</font></tt><br><br>|;
		@header = ('　');

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

# 1つのツリーを出力する
sub output_tree
{
	my $node = shift;
	my $output = '';

	# 出力
	$output .= output_node($node);

	# 子があるなら
	if (q_article($node, 'has_child')) {
		for my $node (@{ $kids{$node} }) { $output .= output_tree($node) }
		pop @header;
	}
	return $output;
}


# 1つのノードを出力する
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 = "投稿者: $user\0".$msg;
	}

	$_ = $msg;

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

	# 2つ前の返信を消す
	s|&gt; &gt;.*?\0\0?||g;

	# 1つ前の返信を消す
	my $pre_msg;	# 1つ前の返信
	if (s|(&gt;.*?)\0\0||g) { $pre_msg = $1; }

	# 参考を消す
	s|<A href=[^>]*?>参考：[^>]*?</A>||g;

	# 投稿文末尾の連続する改行をトリミング
	s|[\0]{2,}$|\0|g;

	# 記事
	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_article($node, 'has_child')  and  $header[-1] = "<font color='#$treeview{branch_color}'>│</font>";

	# 末の子なら自分の頭を'　'に変える
	q_article($node, 'is_last')  and  $header[-1] = '　';

	# 子がいないならポップ
	not q_article($node, 'has_child')  and  pop @header;

	# 新着記事なら色を変える
	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);
}

# 各種問い合わせ
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};

		# ルートなら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*)[^>]*?>参考|i ?  return $1 : return undef;
#		$msg =~ m|<A href="m=f&s=(\d*)[^>]*?>参考|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}) { 
		# ルートが存在しない場合
		# 
		# ダミーのルートを作成し
		# その子として登録する
		# 
			$logdata{$thread} = make_dummy_article($thread);
			push @{ $kids{$thread} }, $postid;
		} elsif (q_article($thread, 'is_dummy') == -1) {
		# ダミールートが存在する場合
		# 注意: -1はTRUE
			if ($logdata{$parent_postid}) {
				push @{ $kids{$parent_postid} }, $postid;
			} else {
				push @{ $kids{$thread} }, $postid;
			}
		} elsif ($logdata{$thread}) {
		# ルートが存在する場合
		# 
			push @{ $kids{$parent_postid} }, $postid;
		}
	}
	return %kids;
}


# 記事が見つからなかったときのダミー記事を提供する
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;
	}

	# @threadIDから重複した要素を削除
	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;