# FILE: fcn-tree.pl
# DESCRIPTION: Tree file manipulations
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### pages_upward_update
###
### Updates parent pages with new information from the tree file.  Send
### in a list of child pages as an array reference in $pages...
###

sub pages_upward_update {
	my ($tree_file_in, $cat_array, $pages, $args) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	undef my $do_nums;
	foreach my $i (@{ $pages }) {
		my $parents = tree_build_parents_of($tree_file_in, $cat_array, $i);
		foreach my $l (@{ $parents }) {
			$do_nums->{$l} += 1;
		}
		$do_nums->{$i} += 1 if $args->{do_page};
	}
	foreach my $i (keys(%{ $do_nums })) {
		my $rescode = lock("--REGENERATE-SUBTOPICS--", "$DCONF->{message_dir}/$tree_file_in->[0]->{topic}/$i.$DCONF->{ext}");
		if ($rescode == 1) {
			my $pref = GetPage($tree_file_in->[0]->{topic}, $i);
			$pref->{general}->{subtopic_raw} = 0;
			$pref->{sublist} = expand_sublist($pref->{sublist}, $tree_file_in->[0]->{topic}, $tree_file_in);
			SetPage($pref, { unlock => 1} );
		}
	}
}

###
### tree_remove_page
###
### Updates the tree file to reflect one or more pages being removed.  Also
### handles deleting child pages and it works for links.  Send entries for
### pages being removed.
###

sub tree_remove_page {
	my ($tfi, $cat_array, $pages_to_remove, $p) = @_;
	$cat_array = tree_categorize($tfi) if ! defined $cat_array;
	my @REMOVED = ();
	my @SAVED = ();
	my %c = ref $pages_to_remove eq 'HASH' ? %{$pages_to_remove} : map { $_, 1 } split(/,/, $pages_to_remove);
	foreach my $line (@{ $tfi }) {
		if ($c{$line->{page}} || $c{$line->{parent}}) {
			push @REMOVED, $line;
			$c{$line->{page}} = 1;
		} else {
			push @SAVED, $line;
		}
	}
	my @pg = ();
	foreach my $line (@REMOVED) {
		push @pg, split(/,/, $line->{post_list});
	}
	my $tf = \@SAVED;
	my $ca = tree_categorize(\@SAVED);
	($tf, $ca) = tree_upward_update($tf, $ca, $p, { metoo => 1, posts => join("", "-", scalar(@pg)), subs => join("", "-", scalar(@REMOVED)) }) if $p;	
	return ($tf, $ca, \@pg, \@REMOVED);
}

###
### tree_remove_message
###
### Updates the tree to reflect one or more messages removed -- optimized for
### use when deleting messages from a page either by pruning or deleting.
### Send messages being removed as an array reference with the following:
###		page =>		Page from which messages are being removed
###		messages =>	Comma-separated list of messages to be removed
###

sub tree_remove_message {
	my ($tree_file_in, $cat_array, $messages_being_removed) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	foreach my $i (@{ $messages_being_removed }) {
		my ($p, $m) = ($i->{page}, $i->{messages});
		my $ind = $cat_array->{array_pos}->{$p};
		my $fpl = $tree_file_in->[$ind]->{post_list};
		my $rem = 0;
		undef my $nix;
		foreach my $j (split(/,/, $m)) {
			$nix->{$j} = 1;
		}
		my @leave = ();
		foreach my $j (split(/,/, $fpl)) {
			if ($nix->{$j}) {
				$rem += 1;
			} else {
				push (@leave, $j);
			}
		}
		$tree_file_in->[$ind]->{post_list} = join(",", @leave);
		($tree_file_in, $cat_array) = tree_upward_update($tree_file_in, $cat_array, $p, { metoo => 1, posts => "-$rem" }) if $rem;
	}
	return ($tree_file_in, $cat_array);
}

###
### tree_subtopic_reorder
###
### Performs reordering according to user-supplied information
###

sub tree_subtopic_reorder {
	my ($tree_file_in, $cat_array, $starting, $coderef, $sor) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	my $tbco = tree_build_children_of($tree_file_in, $cat_array, $starting);
	my @sor = sort {&{$coderef}} @{$tbco};
	@sor = tree_flatten(\@sor);
	@sor = sort sort_archive_method @sor if $sor && $GLOBAL_OPTIONS->{sort_archive_method_on};
	unshift @sor, $cat_array->{page}->{$starting};
	splice(@{ $tree_file_in }, $cat_array->{array_pos}->{$starting}, scalar(@sor), @sor);
	return ($tree_file_in, $cat_array);
}

###
### tree_active_reorder
###
### Performs active reordering (reorder by last modified date)
###

sub tree_active_reorder {
	my ($tree_file_in, $cat_array, $starting, $args) = @_;
	my $coderef = sub { return $a->[0]->{lastmod} <=> $b->[0]->{lastmod} };
	return tree_subtopic_reorder($tree_file_in, $cat_array, $starting, $coderef, 1);
}

###
### tree_flatten
###
### Flattens tree information
###

sub tree_flatten {
	my ($array_in) = @_;
	my @aout = ();
	foreach my $x (@{$array_in}) {
		if (ref $x eq 'ARRAY') {
			push @aout, tree_flatten($x);
		} else {
			push @aout, $x;
		}
	}
	return @aout;	
}

###
### tree_upward_update
###
### Updates the tree in an upward direction
###

sub tree_upward_update {
	my ($tree_file_in, $cat_array, $starting, $args) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	if ($args->{metoo}) {
		$tree_file_in->[$cat_array->{array_pos}->{$starting}] = _tree_upward_update($tree_file_in->[$cat_array->{array_pos}->{$starting}], $args);
	}
	my $parent = $cat_array->{parent}->{$starting};
	if ($parent != 0 && $parent != $starting) {
		my $parent_pos = $cat_array->{array_pos}->{$parent};
		$tree_file_in->[$parent_pos] = _tree_upward_update($tree_file_in->[$parent_pos], $args);
		$args->{metoo} = undef;
		($tree_file_in, $cat_array) = tree_upward_update($tree_file_in, $cat_array, $parent, $args);
	}
	return ($tree_file_in, $cat_array);
}

sub _tree_upward_update {
	my ($hash, $args) = @_;
	foreach my $part ('subs', 'posts') {
		if ($args->{$part} =~ m|^-(\d+)|) {
			$hash->{$part} -= $1;
		} elsif ($args->{$part} =~ m|^\+(\d+)|) {
			$hash->{$part} += $1;
		}
	}
	if (! defined $args->{safe} || $args->{safe} == 0) {
		$hash->{lastmod} = $args->{lastmod} if defined $args->{lastmod};
		$hash->{last_poster} = $args->{last_poster} if defined $args->{last_poster};
	} elsif ($args->{lastmod} > $hash->{lastmod}) {
		$hash->{lastmod} = $args->{lastmod} if $args->{lastmod};
		$hash->{last_poster} = $args->{last_poster} if defined $args->{last_poster};
	}
	return $hash;
}

###
### tree_insert_record
###
### Inserts a new record into the tree file
###

sub tree_insert_record {
	my ($tree_file_in, $cat_array, $new_hash_in, $args) = @_;
	my $position = defined $args->{position} ? $args->{position} : 0;
	my @nh = ref $new_hash_in eq "ARRAY" ? @{ $new_hash_in } : ($new_hash_in);
	my $new_hash = $nh[0];
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	$new_hash->{level} = 1 + ($cat_array->{page}->{$new_hash->{parent}}->{level});
	my @tfin = @{ $tree_file_in };
	if ($position == 1) {
		splice(@tfin, 1+$cat_array->{array_pos}->{ $new_hash->{parent} }, 0, @nh);
	} elsif ($position == 0) {
		my $tldo = tree_last_descendant_of(\@tfin, $cat_array, $new_hash->{parent}, $new_hash->{param});
		splice(@tfin, 1+$tldo->{array_pos}, 0, @nh);
	} elsif ($position == 2) {
		my $tbco = tree_build_children_of(\@tfin, $cat_array, $new_hash->{parent});
		my @ch = ();
		if (defined($tbco)) {
			@ch = @{ $tbco };
		}
		push (@ch, @nh);
		my $sortroutine = sub {
			my $_a = ref $a eq 'ARRAY' ? lc(trim($a->[0]->{name})) : ref $a eq 'HASH' ? $a->{name} : "";
			my $_b = ref $b eq 'ARRAY' ? lc(trim($b->[0]->{name})) : ref $b eq 'HASH' ? $b->{name} : "";
			return $_a cmp $_b;
		};
		my @sor = tree_dump_into_array(sort { &{$sortroutine} } @ch);
		splice(@tfin, 1+$cat_array->{array_pos}->{ $new_hash->{parent} }, scalar(@sor)-scalar(@nh), @sor);
	}
	return (\@tfin, $cat_array);
}

###
### tree_dump_into_array
###
### Collapses an array of arrays into one single array
###

sub tree_dump_into_array {
	my @result = ();
	while (my $x = shift (@_)) {
		if (ref $x eq "ARRAY") {
			push (@result, tree_dump_into_array(@{ $x }));
		} else {
			push (@result, $x);
		}
	}
	return @result;
}

###
### tree_build_parents_of
###
### Builds up the parents of a given page
###

sub tree_build_parents_of {
	my ($tree_file_in, $cat_array, $starting) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	my @result = ();
	my $parent = $cat_array->{parent}->{$starting};
	if ($parent != 0 && $parent != $starting) {
		push (@result, $parent);
		push (@result, @{tree_build_parents_of($tree_file_in, $cat_array, $parent)});
	}
	return \@result;
}

###
### tree_build_children_of
###
### Builds arrays of children of a given parent page
###

sub tree_build_children_of {
	my ($tree_file_in, $cat_array, $inquiry) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	if (defined $cat_array->{child}->{$inquiry}) {
		my @ret = ();
		my @a = @{ $cat_array->{child}->{$inquiry} };
		foreach my $a (@a) {
			my @x = ();
			push @x, $cat_array->{page}->{$a};
			my $y = tree_build_children_of($tree_file_in, $cat_array, $a);
			push @x, @{ $y };
			push @ret, \@x;
		}
		return \@ret;
	} else {
		my @y = ();
		return \@y;
	}
}

###
### tree_build_siblings_of
###
### Finds sibling pages
###

sub tree_build_siblings_of {
	my ($tree_file_in, $cat_array, $inquiry) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	my $par = $cat_array->{parent}->{$inquiry};
	my @z = grep($_->{parent} == $par, @{$tree_file_in});
	return \@z;
}	

###
### tree_last_descendant_of
###
### Determines the last descendant of a given parent page
###

sub tree_last_descendant_of {
	my ($tree_file_in, $cat_array, $inquiry, $param) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	if (defined $cat_array->{child}->{$inquiry}) {
		my @a = @{ $cat_array->{child}->{$inquiry} };
		@a = grep($cat_array->{page}->{$_}->{param} !~ /Archive/, @a) if $param !~ /Archive/;
		my $lr = $a[$#a];
		if ($lr != 0) {
			return tree_last_descendant_of($tree_file_in, $cat_array, $lr, $param);
		} else {
			undef my $answer;
			$answer->{childnum} = $inquiry;
			$answer->{array_pos} = $cat_array->{array_pos}->{$inquiry};
			return $answer;
		}
	} else {
		undef my $answer;
		$answer->{childnum} = $inquiry;
		$answer->{array_pos} = $cat_array->{array_pos}->{$inquiry};
		return $answer;
	}
}

###
### tree_push_post
###
### Adds a post to a given hash in the tree file
###

sub tree_push_post {
	my ($tree_file_in, $cat_array, $page, $post, $position) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	my @pl = split(/,/, $cat_array->{page}->{$page}->{post_list});
	push @pl, $post if $position == 0;
	unshift @pl, $post if $position == 1;
	my $post_list = join(",", @pl);
	$tree_file_in = tree_record_update($tree_file_in, $cat_array, { page => $page, post_list => $post_list });
	$cat_array->{page}->{$page}->{post_list} = $post_list;
	return ($tree_file_in, $cat_array);	
}

###
### tree_record_update
###
### Updates one record from the tree file.
###

sub tree_record_update {
	my ($tree_file_in, $cat_array, $updated_hash, $as_hash) = @_;
	$cat_array = tree_categorize($tree_file_in) if ! defined $cat_array;
	if (defined $cat_array->{array_pos}->{$updated_hash->{page}}) {
		my $j = $cat_array->{page}->{$updated_hash->{page}};
		foreach my $x ('level', 'topic', 'page', 'parent', 'name', 'param', 'url', 'posts', 'properties', 'islink', 'target', 'lastmod', 'originator', 'post_list', 'subs', 'last_poster', 'icon') {
			$updated_hash->{$x} = defined $updated_hash->{$x} ? $updated_hash->{$x} : $j->{$x};
		}
		$tree_file_in->[ $cat_array->{array_pos}->{ $updated_hash->{page} } ] = $updated_hash;
	}
	return $tree_file_in if ! $as_hash;
	return { tree => $tree_file_in, cat => $cat_array };
}

###
### tree_categorize
###
### Categorizes the tree file for easy updating.
###

sub tree_categorize {
	my ($tree_file_in) = @_;
	my $counter = 0;
	undef my $cat;
	foreach my $hash (@{ $tree_file_in }) {
		$cat->{array_pos}->{ $hash->{page} } = $counter; $counter++;
		$cat->{parent}->{ $hash->{page} } = $hash->{parent};
		$cat->{page}->{ $hash->{page} } = $hash;
		push (@{ $cat->{child}->{$hash->{parent}} }, $hash->{page}) if $hash->{page} != 0;
	}
	return $cat;
}


1;
