/[webpac]/trunk2/lib/WebPAC/Tree.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk2/lib/WebPAC/Tree.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 453 by dpavlin, Tue Sep 14 20:57:58 2004 UTC revision 454 by dpavlin, Wed Sep 15 22:36:23 2004 UTC
# Line 5  use strict; Line 5  use strict;
5    
6  use Carp;  use Carp;
7  use Log::Log4perl qw(get_logger :levels);  use Log::Log4perl qw(get_logger :levels);
 use locale;  
8    
9  =head1 NAME  =head1 NAME
10    
# Line 23  of tree individually (so you can limit d Line 22  of tree individually (so you can limit d
22    
23   my @tree = ({   my @tree = ({
24          # level 0          # level 0
25          code_arr        => sub { @{$l->{$_[0]}} },          code_arr        => sub { @{$_[0]} },
26          filter_code     => sub { shift },          filter_code     => sub { shift },
27          lookup_v900     => sub {          lookup_v900     => sub {
28                                  my ($c,$p) = @_;                                  my ($c,$p) = @_;
# Line 32  of tree individually (so you can limit d Line 31  of tree individually (so you can limit d
31                          },                          },
32          lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },          lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
33          lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },          lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
34          have_children   => sub { defined($l->{$_[1]}) },          have_children   => sub { return $l->{$_[1]} },
         child_code      => sub { return $_[1] },  
35          },{          },{
36          # level 1          # level 1
37          code_arr        => sub { @{$l->{$_[0]}} },          code_arr        => sub { @{$_[0]} },
38          filter_code     => sub { shift },          filter_code     => sub { shift },
39          lookup_v900     => sub {          lookup_v900     => sub {
40                                  my ($c,$p) = @_;                                  my ($c,$p) = @_;
# Line 46  of tree individually (so you can limit d Line 44  of tree individually (so you can limit d
44          lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },          lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
45          lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },          lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
46          have_children   => sub { 0 },          have_children   => sub { 0 },
         child_code      => sub { 0 },  
47   )};   )};
48    
49    You can, however, create recursion with C<have_children_at_level> discussed
50    below, but you loose ability to limit tree depth or to specify different
51    style for each level.
52    
53  Documentation for each element of tree is little sparse, but here it is:  Documentation for each element of tree is little sparse, but here it is:
54    
55  =over 5  =over 5
# Line 90  Lookup mfn value, used to create hyperli Line 91  Lookup mfn value, used to create hyperli
91    
92  =item have_children  =item have_children
93    
94  Returns C<true> or C<false> depending if current node have children.  Returns children for next iteration of tree generation or undef.
95    
96     my $next_lvl = $t->{'have_children'}->($code,$v900,$start_code);
97    
98   if ($t->{'have_children'}->($code,$v900,$start_code)) { ... }  =item have_children_at_level
99    
100  =item child_code  Returns children for next iteration and next level.
101    
102  Returns child code for next iteration of tree generation.   my ($level,$next_lvl) = $t->{'have_children_at_level'}->($code,$v900,$start_code);
103    
104   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
105    above) to stop recursion.
106    
107  =back  =back
108    
# Line 190  sub unroll { Line 194  sub unroll {
194    
195          my ($level,$start_code) = @_;          my ($level,$start_code) = @_;
196    
197            my $next_level = $level + 1;
198    
199          my $log = $self->_get_logger();          my $log = $self->_get_logger();
200    
201          $log->logconfess("need level") unless (defined($level));          $log->logconfess("need level") unless (defined($level));
# Line 226  sub unroll { Line 232  sub unroll {
232                          my ($link_start,$link_end) = ('','');                          my ($link_start,$link_end) = ('','');
233                    
234                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900,$start_code);                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900,$start_code);
235                          if ($have_children) {  
236                                  ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>});                          if (! $have_children) {
                         } else {  
237                                  $log->debug("# $level doesn't have_children($code,$v900,$start_code)");                                  $log->debug("# $level doesn't have_children($code,$v900,$start_code)");
238                                    ($next_level,$have_children) = $tree->[$level]->{'have_children_at_level'}->($code,$v900,$start_code) if ($tree->[$level]->{'have_children_at_level'});
239                                    $log->debug("# $level have_children($code,$v900,$start_code) on level $next_level") if ($have_children);
240    
241                          }                          }
242    
243                            ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);
244    
245                          my $mfn_link = "thes/$mfn.html";                          my $mfn_link = "thes/$mfn.html";
246                          if (-e "out/$mfn_link") {                          if (-e "out/$mfn_link") {
247                                  $html .= " " x $level .                                  $html .= " " x $level .
# Line 262  sub unroll { Line 272  sub unroll {
272                                  push @{$self->{'show_ids'}}, "id$mfn";                                  push @{$self->{'show_ids'}}, "id$mfn";
273                          }                          }
274    
275                          $html .= $self->unroll($level+1, $tree->[$level]->{'child_code'}->($code,$v900,$start_code));                          $html .= $self->unroll($next_level, $have_children);
276                                                    
277                          $html .= " " x $level . qq{</ul>\n};                          $html .= " " x $level . qq{</ul>\n};
278    
Legend:
Removed from v.453  
changed lines
  Added in v.454
  ViewVC Help
Powered by ViewVC 1.1.26