--- trunk2/lib/WebPAC/Tree.pm	2004/09/14 17:10:04	442
+++ trunk2/lib/WebPAC/Tree.pm	2004/09/26 16:44:23	472
@@ -5,7 +5,7 @@
 
 use Carp;
 use Log::Log4perl qw(get_logger :levels);
-use locale;
+use YAML;
 
 =head1 NAME
 
@@ -23,7 +23,7 @@
 
  my @tree = ({
  	# level 0
-	code_arr	=> sub { @{$l->{$_[0]}} },
+	code_arr	=> sub { @{$_[0]} },
 	filter_code	=> sub { shift },
 	lookup_v900	=> sub {
 				my ($c,$p) = @_;
@@ -32,11 +32,10 @@
 			},
 	lookup_term	=> sub { shift @{$l->{"d:".$_[0]}} },
 	lookup_mfn	=> sub { shift @{$l->{"900_mfn:".$_[0]}} },
-	have_children	=> sub { defined($l->{$_[1]}) },
-	child_code	=> sub { return $_[1] },
+	have_children	=> sub { return $l->{$_[1]} },
 	},{
 	# level 1
-	code_arr	=> sub { @{$l->{$_[0]}} },
+	code_arr	=> sub { @{$_[0]} },
 	filter_code	=> sub { shift },
 	lookup_v900	=> sub {
 				my ($c,$p) = @_;
@@ -46,9 +45,12 @@
 	lookup_term	=> sub { shift @{$l->{"d:".$_[0]}} },
 	lookup_mfn	=> sub { shift @{$l->{"900_mfn:".$_[0]}} },
 	have_children	=> sub { 0 },
-	child_code	=> sub { 0 },
  )};
 
+You can, however, create recursion with C<have_children_at_level> discussed
+below, but you loose ability to limit tree depth or to specify different
+style for each level.
+
 Documentation for each element of tree is little sparse, but here it is:
 
 =over 5
@@ -74,7 +76,7 @@
 
 Lookup value which will be called C<$v900> from now on.
 
- my $v900 = $t->{'lookup_v900'}->($code,$start_code);
+ my $v900 = $t->{'lookup_v900'}->($code);
 
 =item lookup_term
 
@@ -90,15 +92,18 @@
 
 =item have_children
 
-Returns C<true> or C<false> depending if current node have children.
+Returns children for next iteration of tree generation or undef.
+
+ my $next_lvl = $t->{'have_children'}->($code,$v900);
 
- if ($t->{'have_children'}->($code,$v900,$start_code)) { ... }
+=item have_children_at_level
 
-=item child_code
+Returns children for next iteration and next level.
 
-Returns child code for next iteration of tree generation.
+ my ($level,$next_lvl) = $t->{'have_children_at_level'}->($code,$v900);
 
- my $child_code = $t->{'child_code'}->($code,$v900,$start_code);
+It's safe to return undef just for next level data (C<$next_lvl> in example
+above) to stop recursion.
 
 =back
 
@@ -151,7 +156,9 @@
 	$self->{'show_ids'} = [];
 	$self->{'hide_ids'} = [];
 
-	my $html = $self->unroll(0,'');
+	my $html = $self->unroll(0,());
+
+	$log->logdie("no html generated by unroll...") unless ($html);
 
 	my $html_file = $self->{'dir'}.'/'.$self->{'html'};
 
@@ -181,19 +188,26 @@
 
 Generate tree recursively.
 
- my $html = $tree->unroll($level,$start_code);
+ my $html = $tree->unroll($level,$data_arr);
 
 =cut
 
 sub unroll {
 	my $self = shift;
 
-	my ($level,$start_code) = @_;
+	my ($level,$data_arr) = @_;
 
 	my $log = $self->_get_logger();
 
+	if (! defined($level)) {
+		$log->warn("level is undef, stoping recursion...");
+		return;
+	}
+
+	my $next_level = $level + 1;
+
 	$log->logconfess("need level") unless (defined($level));
-	$log->logconfess("need start_code") unless (defined($start_code));
+	#$log->logconfess("need data_arr") unless (defined($data_arr));
 
 	my $tree = $self->{'tree'};
 
@@ -202,41 +216,45 @@
 	# all levels passed?
 	return if (! defined($tree->[$level]));
 
-	$log->debug("unroll level $level, start code $start_code");
+	$log->debug("unroll level $level");
 
 	my $html;
 
-	foreach my $code ($tree->[$level]->{'code_arr'}->($start_code)) {
+	foreach my $code ($tree->[$level]->{'code_arr'}->($data_arr)) {
 
 		if ($code = $tree->[$level]->{'filter_code'}->($code)) {
 		
 			$log->debug("# $level filter passed code $code");
 
-			my $v900 = $tree->[$level]->{'lookup_v900'}->($code,$start_code) || $log->warn("can't lookup_v900($code,$start_code)");
-			$log->debug("# $level lookup_v900($code,$start_code) = $v900");
+			my $v900 = $tree->[$level]->{'lookup_v900'}->($code) || $log->warn("can't lookup_v900($code)") && return;
+			$log->debug("# $level lookup_v900($code) = $v900");
 
-			my $term = $tree->[$level]->{'lookup_term'}->($code,$v900) || $log->warn("can't lookup_term($code,$v900)");
+			my $term = $tree->[$level]->{'lookup_term'}->($code,$v900) || $log->warn("can't lookup_term($code,$v900)") && next;
 			$log->debug("# $level lookup_term($code,$v900) = $term");
 
-			my $mfn  = $tree->[$level]->{'lookup_mfn'}->($code,$v900)  || $log->warn("can't lookup_mfn($code,$v900)");
+			my $mfn  = $tree->[$level]->{'lookup_mfn'}->($code,$v900)  || $log->warn("can't lookup_mfn($code,$v900)") && next;
 			$log->debug("# $level lookup_mfn($code,$v900) = $mfn");
 
 			$log->debug("$code -> $v900 : $term [$mfn]");
 
 			my ($link_start,$link_end) = ('','');
 	
-			my $have_children = $tree->[$level]->{'have_children'}->($code,$v900,$start_code);
-			if ($have_children) {
-				($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>});
-			} else {
-				$log->debug("# $level doesn't have_children($code,$v900,$start_code)");
+			my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);
+
+			if (! $have_children) {
+				$log->debug("# $level doesn't have_children($code,$v900)");
+				($next_level,$have_children) = $tree->[$level]->{'have_children_at_level'}->($code,$v900) if ($tree->[$level]->{'have_children_at_level'});
+				$log->debug("# $level have_children($code,$v900) on level $next_level") if ($have_children);
+
 			}
 
+			($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);
+
 			my $mfn_link = "thes/$mfn.html";
 			if (-e "out/$mfn_link") {
 				$html .= " " x $level .
-					qq{<li>${link_start}${term}${link_end}}.
-					qq{&nbsp;<a href="$mfn_link">&raquo;</a></li>\n};
+					qq{<li><a name="mfn${mfn}"></a>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
+					qq{&nbsp;<a href="$mfn_link" onClick="javascript:return popup(this);">&raquo;</a></li>\n};
 			} else {
 				$log->warn("file 'out/$mfn_link' doesn't exist, skipping");
 			}
@@ -247,7 +265,7 @@
 			my $style = $tree->[$level]->{'style'};
 
 			$html .= " " x $level .
-				qq{<a name="mfn$mfn"></a>\n <ul id="id$mfn"}.
+				qq{<ul id="id$mfn"}.
 				($style ? ' style="'.$style.'"' : '').
 				qq{>\n};
 
@@ -262,7 +280,7 @@
 				push @{$self->{'show_ids'}}, "id$mfn";
 			}
 
-			$html .= $self->unroll($level+1, $tree->[$level]->{'child_code'}->($code,$v900,$start_code));
+			$html .= $self->unroll($next_level, $have_children);
 			
 			$html .= " " x $level . qq{</ul>\n};