/[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 443 by dpavlin, Tue Sep 14 20:57:58 2004 UTC revision 455 by dpavlin, Mon Sep 20 19:13:27 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 192  sub unroll { Line 196  sub unroll {
196    
197          my $log = $self->_get_logger();          my $log = $self->_get_logger();
198    
199            if (! defined($level)) {
200                    $log->warn("level is undef, stoping recursion...");
201                    return;
202            }
203    
204            my $next_level = $level + 1;
205    
206          $log->logconfess("need level") unless (defined($level));          $log->logconfess("need level") unless (defined($level));
207          $log->logconfess("need start_code") unless (defined($start_code));          $log->logconfess("need start_code") unless (defined($start_code));
208    
# Line 226  sub unroll { Line 237  sub unroll {
237                          my ($link_start,$link_end) = ('','');                          my ($link_start,$link_end) = ('','');
238                    
239                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900,$start_code);                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900,$start_code);
240                          if ($have_children) {  
241                                  ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>});                          if (! $have_children) {
                         } else {  
242                                  $log->debug("# $level doesn't have_children($code,$v900,$start_code)");                                  $log->debug("# $level doesn't have_children($code,$v900,$start_code)");
243                                    ($next_level,$have_children) = $tree->[$level]->{'have_children_at_level'}->($code,$v900,$start_code) if ($tree->[$level]->{'have_children_at_level'});
244                                    $log->debug("# $level have_children($code,$v900,$start_code) on level $next_level") if ($have_children);
245    
246                          }                          }
247    
248                            ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);
249    
250                          my $mfn_link = "thes/$mfn.html";                          my $mfn_link = "thes/$mfn.html";
251                          if (-e "out/$mfn_link") {                          if (-e "out/$mfn_link") {
252                                  $html .= " " x $level .                                  $html .= " " x $level .
# Line 262  sub unroll { Line 277  sub unroll {
277                                  push @{$self->{'show_ids'}}, "id$mfn";                                  push @{$self->{'show_ids'}}, "id$mfn";
278                          }                          }
279    
280                          $html .= $self->unroll($level+1, $tree->[$level]->{'child_code'}->($code,$v900,$start_code));                          $html .= $self->unroll($next_level, $have_children);
281                                                    
282                          $html .= " " x $level . qq{</ul>\n};                          $html .= " " x $level . qq{</ul>\n};
283    

Legend:
Removed from v.443  
changed lines
  Added in v.455

  ViewVC Help
Powered by ViewVC 1.1.26