/[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 469 by dpavlin, Fri Sep 24 18:04:48 2004 UTC revision 574 by dpavlin, Mon Nov 1 17:19:48 2004 UTC
# Line 6  use strict; Line 6  use strict;
6  use Carp;  use Carp;
7  use Log::Log4perl qw(get_logger :levels);  use Log::Log4perl qw(get_logger :levels);
8  use YAML;  use YAML;
9    use Template;
10    
11  =head1 NAME  =head1 NAME
12    
# Line 14  WebPAC::Tree - create tree from lookup d Line 15  WebPAC::Tree - create tree from lookup d
15  =head1 DESCRIPTION  =head1 DESCRIPTION
16    
17  This module will create tree from lookup data. It requires quite complicated  This module will create tree from lookup data. It requires quite complicated
18  data structure, but once you get hang of that, it's peace of case :-)  data structure, but once you get hang of that, it's peace of cake :-)
19    
20  Data structure for tree definition is non-recursive, and defines each level  Data structure for tree definition is non-recursive, and defines each level
21  of tree individually (so you can limit depth of tree) like this:  of tree individually (so you can limit depth of tree) like this:
# Line 33  of tree individually (so you can limit d Line 34  of tree individually (so you can limit d
34          lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },          lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
35          lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },          lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
36          have_children   => sub { return $l->{$_[1]} },          have_children   => sub { return $l->{$_[1]} },
37            iframe          => 1,
38          },{          },{
39          # level 1          # level 1
40          code_arr        => sub { @{$_[0]} },          code_arr        => sub { @{$_[0]} },
# Line 45  of tree individually (so you can limit d Line 47  of tree individually (so you can limit d
47          lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },          lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
48          lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },          lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
49          have_children   => sub { 0 },          have_children   => sub { 0 },
50            style           => 'display: none',
51   )};   )};
52    
53  You can, however, create recursion with C<have_children_at_level> discussed  You can, however, create recursion with C<have_children_at_level> discussed
# Line 105  Returns children for next iteration and Line 108  Returns children for next iteration and
108  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
109  above) to stop recursion.  above) to stop recursion.
110    
111    =item iframe
112    
113    This optional option will create all children nodes in separate file, and iframe in tree html,
114    so that generated tee html will have resonable size with large number of nodes.
115    
116    =item style
117    
118    Optional option to specify style of this node.
119    
120  =back  =back
121    
122  =head1 METHODS  =head1 METHODS
# Line 114  above) to stop recursion. Line 126  above) to stop recursion.
126  Create new tree object  Create new tree object
127    
128   my $tree = new WebPAC::Tree(   my $tree = new WebPAC::Tree(
         dir => './out',  
         html => 'browse.html',  
         template => './output_template/tree.tt',  
         js => 'tree-ids.js',  
129          tree => \@tree,          tree => \@tree,
130          log => 'log4perl.conf',          log => 'log4perl.conf',
131            detail_url => sub {
132                    my $mfn = shift;
133                    my $path = "thes/${mfn}.html";
134                    return $path if (-e "./out/$path");
135            },
136            iframe_base => '../',
137   );   );
138    
 C<dir> is output directory in which html files and JavaScript files will be  
 created (think of it as C<public_html>).  
   
 C<html> is name of output html file.  
   
 C<template> is name of template. It uses Template Toolkit syntax [% var %],  
 but doesn't really use TT.  
   
 C<js> is name of JavaScript file with shown and hidden ids.  
   
139  C<tree> is tree array with levels of tree described above.  C<tree> is tree array with levels of tree described above.
140    
141  C<log> is optional parametar which specify filename of L<Log::Log4Perl>  C<log> is optional parametar which specify filename of L<Log::Log4Perl>
142  config file. Default is C<log.conf>.  config file. Default is C<log.conf>.
143    
144    C<detail_url> code ref to check if detail html exists (and return URL if
145    it does).
146    
147    C<iframe_base> is relative path from C<dir> defiend in C<output> to root
148    (which is inserted in all html).
149    
150  =cut  =cut
151    
152  sub new {  sub new {
# Line 149  sub new { Line 159  sub new {
159    
160          my $log = $self->_get_logger();          my $log = $self->_get_logger();
161    
162          foreach my $p (qw(dir html template js tree)) {          $log->logconfess("need tree") unless ($self->{'tree'});
                 $log->logconfess("need $p") unless ($self->{$p});  
         }  
163    
164          $self->{'show_ids'} = [];          $self->{'show_ids'} = [];
165          $self->{'hide_ids'} = [];          $self->{'hide_ids'} = [];
166    
167          my $html = $self->unroll(0,());          $self->{'tree_html'} = $self->unroll(0,());
168    
169            if (! $self->{'tree_html'}) {
170                    $log->warn("no html generated by unroll...");
171                    return;
172            }
173    
174            return $self;
175    }
176    
177    =head2 output
178    
179    Create output files from tree object
180    
181     $tree->output(
182            dir => './out',
183            html => 'browse.html',
184            template_dir => './output_template/',
185            template_tree => 'tree.tt',
186            template_node => 'node.tt',
187            nodes => 'nodes',
188            js => 'tree-ids.js',
189     );
190    
191    C<dir> is output directory in which html files and JavaScript files will be
192    created (think of it as C<public_html>).
193    
194    C<html> is name of output html file.
195    
196    C<template_dir> is directory with Template Toolkit templates.
197    
198    C<template_tree> is name of template to produce tree.
199    
200    C<template_node> is (optional) name of template for node (if C<iframe>
201    options is used within tree definition).
202    
203          my $html_file = $self->{'dir'}.'/'.$self->{'html'};  C<nodes> is directory in C<dir> in which html for iframes will be located.
204    See also C<iframe_base> for relative dir out of this directory.
205    
206          open(TEMPLATE, $self->{'template'}) || $log->logdie("can't open '",$self->{'template'},": $!");  C<js> is name of JavaScript file with shown and hidden ids.
207          my $tmpl;  
208          while(<TEMPLATE>) {  =cut
209                  $tmpl .= $_;  
210    sub output {
211            my $self = shift;
212    
213            my $args = {@_};
214    
215            my $log = $self->_get_logger();
216    
217            foreach my $p (qw(dir html template_dir template_tree js)) {
218                    $log->logconfess("need $p") unless ($args->{$p});
219            }
220    
221            my $html = $self->{'tree_html'};
222            unless ($html) {
223                    $log->warn("no html, output aborted");
224                    return;
225          }          }
         close(TEMPLATE);  
226    
227          $log->info("creating '$html_file' with tree");          my $html_file = $args->{'dir'}.'/'.$args->{'html'};
228    
229            $log->debug("templates are in ",$args->{'template_dir'});
230    
231            my $tt = Template->new(
232                    INCLUDE_PATH => $args->{'template_dir'},
233            );
234    
235            my $var = {
236                    js => $args->{'dir'}.'/'.$args->{'js'},
237                    tree => $html,
238            };
239    
240            $log->info("creating '$html_file' with tree from ",$args->{'template_tree'});
241    
242            $tt->process($args->{'template_tree'}, $var, $html_file) || $log->logdie("template error: ",$tt->error());
243    
244            my $js_file = $args->{'dir'}."/".$args->{'js'};
245            $log->info("creating '$js_file' with tree data");
246            $self->generate_js(
247                    file => $js_file,
248            );
249    
250            if (! $args->{'nodes'}) {
251                    $log->warn("skipping node creation");
252                    return $self;
253            }
254    
255          my $js_arr_file = $self->{'js'};          foreach my $mfn (keys %{$self->{'node_html'}}) {
         $tmpl =~ s/\[%\s+js\s+%\]/$js_arr_file/gi;  
         $tmpl =~ s/\[%\s+tree\s+%\]/$html/gi;  
256    
257          open(HTML, ">", $html_file) || $log->logdie("can't open '$html_file': $!");                  my $html_file = $args->{'dir'}."/".$args->{'nodes'}."/${mfn}.html";
         print HTML $tmpl;  
         close(HTML);  
258    
259          $self->generate_js();                  $log->debug("creating tree node $html_file");
260    
261                    $var = {
262                            node => $self->{'node_html'}->{$mfn},
263                    };
264    
265                    $tt->process($args->{'template_node'}, $var, $html_file) || $log->logdie("template error: ",$tt->error());
266            }
267    
268          return $self;          return $self;
269  }  }
# Line 193  Generate tree recursively. Line 279  Generate tree recursively.
279  sub unroll {  sub unroll {
280          my $self = shift;          my $self = shift;
281    
282          my ($level,$data_arr) = @_;          my ($level,$data_arr, $base_path) = @_;
283    
284            $base_path ||= '';
285    
286          my $log = $self->_get_logger();          my $log = $self->_get_logger();
287    
# Line 227  sub unroll { Line 315  sub unroll {
315                          my $v900 = $tree->[$level]->{'lookup_v900'}->($code) || $log->warn("can't lookup_v900($code)") && return;                          my $v900 = $tree->[$level]->{'lookup_v900'}->($code) || $log->warn("can't lookup_v900($code)") && return;
316                          $log->debug("# $level lookup_v900($code) = $v900");                          $log->debug("# $level lookup_v900($code) = $v900");
317    
318                          my $term = $tree->[$level]->{'lookup_term'}->($code,$v900) || $log->warn("can't lookup_term($code,$v900)") && return;                          my $term = $tree->[$level]->{'lookup_term'}->($code,$v900) || $log->warn("can't lookup_term($code,$v900)") && next;
319                          $log->debug("# $level lookup_term($code,$v900) = $term");                          $log->debug("# $level lookup_term($code,$v900) = $term");
320    
321                          my $mfn  = $tree->[$level]->{'lookup_mfn'}->($code,$v900)  || $log->warn("can't lookup_mfn($code,$v900)") && return;                          my $mfn  = $tree->[$level]->{'lookup_mfn'}->($code,$v900)  || $log->warn("can't lookup_mfn($code,$v900)") && next;
322                          $log->debug("# $level lookup_mfn($code,$v900) = $mfn");                          $log->debug("# $level lookup_mfn($code,$v900) = $mfn");
323    
324                          $log->debug("$code -> $v900 : $term [$mfn]");                          $log->debug("$code -> $v900 : $term [$mfn]");
325    
326                          my ($link_start,$link_end) = ('<a name="mfn'.$mfn.'"></a>','');                          my ($link_start,$link_end) = ('','');
327                    
328                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);
329    
# Line 248  sub unroll { Line 336  sub unroll {
336    
337                          ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);                          ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);
338    
339                          my $mfn_link = "thes/$mfn.html";                          my $mfn_link;
340                          if (-e "out/$mfn_link") {                          $mfn_link = $self->{'detail_url'}->($mfn) if ($self->{'detail_url'});
341    
342                            if ($mfn_link) {
343                                    $term =~ s/ *#C# */ <img src="${base_path}img\/crovoc.png" border="0">/;
344                                  $html .= " " x $level .                                  $html .= " " x $level .
345                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
346                                          qq{&nbsp;<a href="$mfn_link">&raquo;</a></li>\n};                                          qq{&nbsp;<a href="${base_path}${mfn_link}" onClick="javascript:return popup(this);"><img src="${base_path}img/listic.png" border="0"></a></li>\n};
347                                    $log->debug("linked details to $mfn_link");
348                          } else {                          } else {
349                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");
350                          }                          }
351    
352                            # save mfn for iframe
353                            push @{$self->{'mfn_arr'}}, $mfn;
354    
355                          unless ($have_children) {                          unless ($have_children) {
356                                  next;                                  next;
357                          }                          }
358                          my $style = $tree->[$level]->{'style'};                          my $style = $tree->[$level]->{'style'};
359    
360                          $html .= " " x $level .                          $html .= " " x $level .
361                                  qq{<a name="mfn$mfn"></a>\n <ul id="id$mfn"}.                                  qq{<ul id="id$mfn"}.
362                                  ($style ? ' style="'.$style.'"' : '').                                  ($style ? ' style="'.$style.'"' : '').
363                                  qq{>\n};                                  qq{>\n};
364    
# Line 278  sub unroll { Line 373  sub unroll {
373                                  push @{$self->{'show_ids'}}, "id$mfn";                                  push @{$self->{'show_ids'}}, "id$mfn";
374                          }                          }
375    
376                          $html .= $self->unroll($next_level, $have_children);  
377                                                    if ($tree->[$level]->{'iframe'}) {
378    
379                                    # reset list of current mfns
380                                    $self->{'mfn_arr'} = ();
381    
382                                    # unroll to separate file
383                                    $self->{'node_html'}->{$mfn} = $self->unroll($next_level, $have_children, $self->{'iframe_base'});
384                                    $html .= " " x $level .
385                                    qq{<iframe id="i$mfn" name="i$mfn" width="100%" height="10" frameborder="0" border="0"></iframe>};
386                                    @{$self->{'iframe_mfn'}->{$mfn}} = @{$self->{'mfn_arr'}};
387                                    $log->debug("in this iframe: ", sub { Dump($self->{'iframe_mfn'}->{$mfn}) });
388    
389                            } else {
390                                    # unroll at base HTML
391                                    $html .= $self->unroll($next_level, $have_children, $base_path);
392                            }
393    
394                          $html .= " " x $level . qq{</ul>\n};                          $html .= " " x $level . qq{</ul>\n};
395    
396                  }                  }
# Line 292  sub unroll { Line 403  sub unroll {
403  Generate JavaScript arrays C<show> and C<hide> used to toggle display of  Generate JavaScript arrays C<show> and C<hide> used to toggle display of
404  elements.  elements.
405    
406   $tree->generate_js();   $tree->generate_js(
407            file = "./out/tree-ids.js",
408     );
409    
410  =cut  =cut
411    
412  sub generate_js {  sub generate_js {
413          my $self = shift;          my $self = shift;
414    
415            my $args = {@_};
416    
417          my $log = $self->_get_logger();          my $log = $self->_get_logger();
418    
419          my $js_file = $self->{'dir'}.'/'.$self->{'js'};          my $js_file = $args->{'file'};
420            $log->die("need file") unless ($args->{'file'});
421    
422          $log->info("creating '$js_file' with arrays of shown and hidden ids");          $log->info("creating '$js_file' with arrays of shown and hidden ids");
423    
424          open(JS, ">", $js_file) || $log->logdie("can't open '$js_file': $!");          open(JS, ">", $js_file) || $log->logdie("can't open '$js_file': $!");
425          print JS "var show = ['",join("','",@{$self->{'show_ids'}}),"'];\n";          print JS "var show = ['",join("','",@{$self->{'show_ids'}}),"'];\n";
426          print JS "var hide = ['",join("','",@{$self->{'hide_ids'}}),"'];\n";          print JS "var hide = ['",join("','",@{$self->{'hide_ids'}}),"'];\n";
427    
428            print JS "var mfn_iframe = [\n";
429            foreach my $if (keys %{$self->{'iframe_mfn'}}) {
430                    print JS " ",join(",",map { "[$_:$if]" } @{$self->{'iframe_mfn'}->{$if}}),",\n";
431            }
432            print JS " null\n]\n";
433    
434          close(JS);          close(JS);
435    
436          $log->debug("stored ",scalar @{$self->{'show_ids'}}," shown and ",scalar @{$self->{'hide_ids'}}," hidden elements");          $log->debug("stored ",scalar @{$self->{'show_ids'}}," shown and ",scalar @{$self->{'hide_ids'}}," hidden elements");
Legend:
Removed from v.469  
changed lines
  Added in v.574
  ViewVC Help
Powered by ViewVC 1.1.26