/[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 454 by dpavlin, Wed Sep 15 22:36:23 2004 UTC revision 492 by dpavlin, Sat Oct 9 21:48:30 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);
8    use YAML;
9    
10  =head1 NAME  =head1 NAME
11    
# Line 75  Returns code or C<false> if code has to Line 76  Returns code or C<false> if code has to
76    
77  Lookup value which will be called C<$v900> from now on.  Lookup value which will be called C<$v900> from now on.
78    
79   my $v900 = $t->{'lookup_v900'}->($code,$start_code);   my $v900 = $t->{'lookup_v900'}->($code);
80    
81  =item lookup_term  =item lookup_term
82    
# Line 93  Lookup mfn value, used to create hyperli Line 94  Lookup mfn value, used to create hyperli
94    
95  Returns children for next iteration of tree generation or undef.  Returns children for next iteration of tree generation or undef.
96    
97   my $next_lvl = $t->{'have_children'}->($code,$v900,$start_code);   my $next_lvl = $t->{'have_children'}->($code,$v900);
98    
99  =item have_children_at_level  =item have_children_at_level
100    
101  Returns children for next iteration and next level.  Returns children for next iteration and next level.
102    
103   my ($level,$next_lvl) = $t->{'have_children_at_level'}->($code,$v900,$start_code);   my ($level,$next_lvl) = $t->{'have_children_at_level'}->($code,$v900);
104    
105  It's safe to return undef just for next level data (C<$next_lvl> in example  It's safe to return undef just for next level data (C<$next_lvl> in example
106  above) to stop recursion.  above) to stop recursion.
# Line 155  sub new { Line 156  sub new {
156          $self->{'show_ids'} = [];          $self->{'show_ids'} = [];
157          $self->{'hide_ids'} = [];          $self->{'hide_ids'} = [];
158    
159          my $html = $self->unroll(0,'');          my $html = $self->unroll(0,());
160    
161            if (! $html) {
162                    $log->warn("no html generated by unroll...");
163                    return;
164            }
165    
166          my $html_file = $self->{'dir'}.'/'.$self->{'html'};          my $html_file = $self->{'dir'}.'/'.$self->{'html'};
167    
# Line 185  sub new { Line 191  sub new {
191    
192  Generate tree recursively.  Generate tree recursively.
193    
194   my $html = $tree->unroll($level,$start_code);   my $html = $tree->unroll($level,$data_arr);
195    
196  =cut  =cut
197    
198  sub unroll {  sub unroll {
199          my $self = shift;          my $self = shift;
200    
201          my ($level,$start_code) = @_;          my ($level,$data_arr) = @_;
   
         my $next_level = $level + 1;  
202    
203          my $log = $self->_get_logger();          my $log = $self->_get_logger();
204    
205            if (! defined($level)) {
206                    $log->warn("level is undef, stoping recursion...");
207                    return;
208            }
209    
210            my $next_level = $level + 1;
211    
212          $log->logconfess("need level") unless (defined($level));          $log->logconfess("need level") unless (defined($level));
213          $log->logconfess("need start_code") unless (defined($start_code));          #$log->logconfess("need data_arr") unless (defined($data_arr));
214    
215          my $tree = $self->{'tree'};          my $tree = $self->{'tree'};
216    
# Line 208  sub unroll { Line 219  sub unroll {
219          # all levels passed?          # all levels passed?
220          return if (! defined($tree->[$level]));          return if (! defined($tree->[$level]));
221    
222          $log->debug("unroll level $level, start code $start_code");          $log->debug("unroll level $level");
223    
224          my $html;          my $html;
225    
226          foreach my $code ($tree->[$level]->{'code_arr'}->($start_code)) {          foreach my $code ($tree->[$level]->{'code_arr'}->($data_arr)) {
227    
228                  if ($code = $tree->[$level]->{'filter_code'}->($code)) {                  if ($code = $tree->[$level]->{'filter_code'}->($code)) {
229                                    
230                          $log->debug("# $level filter passed code $code");                          $log->debug("# $level filter passed code $code");
231    
232                          my $v900 = $tree->[$level]->{'lookup_v900'}->($code,$start_code) || $log->warn("can't lookup_v900($code,$start_code)");                          my $v900 = $tree->[$level]->{'lookup_v900'}->($code) || $log->warn("can't lookup_v900($code)") && return;
233                          $log->debug("# $level lookup_v900($code,$start_code) = $v900");                          $log->debug("# $level lookup_v900($code) = $v900");
234    
235                          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;
236                          $log->debug("# $level lookup_term($code,$v900) = $term");                          $log->debug("# $level lookup_term($code,$v900) = $term");
237    
238                          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;
239                          $log->debug("# $level lookup_mfn($code,$v900) = $mfn");                          $log->debug("# $level lookup_mfn($code,$v900) = $mfn");
240    
241                          $log->debug("$code -> $v900 : $term [$mfn]");                          $log->debug("$code -> $v900 : $term [$mfn]");
242    
243                          my ($link_start,$link_end) = ('','');                          my ($link_start,$link_end) = ('','');
244                    
245                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900,$start_code);                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);
246    
247                          if (! $have_children) {                          if (! $have_children) {
248                                  $log->debug("# $level doesn't have_children($code,$v900,$start_code)");                                  $log->debug("# $level doesn't have_children($code,$v900)");
249                                  ($next_level,$have_children) = $tree->[$level]->{'have_children_at_level'}->($code,$v900,$start_code) if ($tree->[$level]->{'have_children_at_level'});                                  ($next_level,$have_children) = $tree->[$level]->{'have_children_at_level'}->($code,$v900) if ($tree->[$level]->{'have_children_at_level'});
250                                  $log->debug("# $level have_children($code,$v900,$start_code) on level $next_level") if ($have_children);                                  $log->debug("# $level have_children($code,$v900) on level $next_level") if ($have_children);
251    
252                          }                          }
253    
# Line 245  sub unroll { Line 256  sub unroll {
256                          my $mfn_link = "thes/$mfn.html";                          my $mfn_link = "thes/$mfn.html";
257                          if (-e "out/$mfn_link") {                          if (-e "out/$mfn_link") {
258                                  $html .= " " x $level .                                  $html .= " " x $level .
259                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.                                          qq{<li><a name="mfn${mfn}"></a>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
260                                          qq{&nbsp;<a href="$mfn_link">&raquo;</a></li>\n};                                          qq{&nbsp;<a href="$mfn_link" onClick="javascript:return popup(this);">&raquo;</a></li>\n};
261                          } else {                          } else {
262                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");
263                          }                          }
# Line 257  sub unroll { Line 268  sub unroll {
268                          my $style = $tree->[$level]->{'style'};                          my $style = $tree->[$level]->{'style'};
269    
270                          $html .= " " x $level .                          $html .= " " x $level .
271                                  qq{<a name="mfn$mfn"></a>\n <ul id="id$mfn"}.                                  qq{<ul id="id$mfn"}.
272                                  ($style ? ' style="'.$style.'"' : '').                                  ($style ? ' style="'.$style.'"' : '').
273                                  qq{>\n};                                  qq{>\n};
274    
Legend:
Removed from v.454  
changed lines
  Added in v.492
  ViewVC Help
Powered by ViewVC 1.1.26