/[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 530 by dpavlin, Tue Oct 19 17:43:52 2004 UTC revision 573 by dpavlin, Mon Nov 1 15:29:17 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 116  Create new tree object Line 128  Create new tree object
128   my $tree = new WebPAC::Tree(   my $tree = new WebPAC::Tree(
129          tree => \@tree,          tree => \@tree,
130          log => 'log4perl.conf',          log => 'log4perl.conf',
131            detail_url => sub {
132                    my $mfn = shift;
133                    my $path = "./out/thes/${mfn}.html";
134                    return $path if (-e $path);
135            },
136   );   );
137    
138  C<tree> is tree array with levels of tree described above.  C<tree> is tree array with levels of tree described above.
# Line 123  C<tree> is tree array with levels of tre Line 140  C<tree> is tree array with levels of tre
140  C<log> is optional parametar which specify filename of L<Log::Log4Perl>  C<log> is optional parametar which specify filename of L<Log::Log4Perl>
141  config file. Default is C<log.conf>.  config file. Default is C<log.conf>.
142    
143    C<detail_url> code ref to check if detail html exists (and return URL if
144    it does).
145    
146  =cut  =cut
147    
148  sub new {  sub new {
# Line 157  Create output files from tree object Line 177  Create output files from tree object
177   $tree->output(   $tree->output(
178          dir => './out',          dir => './out',
179          html => 'browse.html',          html => 'browse.html',
180          template => './output_template/tree.tt',          template_dir => './output_template/',
181            template_tree => 'tree.tt',
182            template_node => 'node.tt',
183          js => 'tree-ids.js',          js => 'tree-ids.js',
184   );   );
185    
# Line 166  created (think of it as C<public_html>). Line 188  created (think of it as C<public_html>).
188    
189  C<html> is name of output html file.  C<html> is name of output html file.
190    
191  C<template> is name of template. It uses Template Toolkit syntax [% var %],  C<template_dir> is directory with Template Toolkit templates.
192  but doesn't really use TT.  
193    C<template_tree> is name of template to produce tree.
194    
195    C<template_node> is (optional) name of template for node (if C<iframe>
196    options is used within tree definition).
197    
198  C<js> is name of JavaScript file with shown and hidden ids.  C<js> is name of JavaScript file with shown and hidden ids.
199    
# Line 180  sub output { Line 206  sub output {
206    
207          my $log = $self->_get_logger();          my $log = $self->_get_logger();
208    
209          foreach my $p (qw(dir html template js)) {          foreach my $p (qw(dir html template_dir template_tree js)) {
210                  $log->logconfess("need $p") unless ($args->{$p});                  $log->logconfess("need $p") unless ($args->{$p});
211          }          }
212    
# Line 192  sub output { Line 218  sub output {
218    
219          my $html_file = $args->{'dir'}.'/'.$args->{'html'};          my $html_file = $args->{'dir'}.'/'.$args->{'html'};
220    
221          open(TEMPLATE, $args->{'template'}) || $log->logdie("can't open '",$args->{'template'},": $!");          $log->debug("templates are in ",$args->{'template_dir'});
222          my $tmpl;  
223          while(<TEMPLATE>) {          my $tt = Template->new(
224                  $tmpl .= $_;                  INCLUDE_PATH => $args->{'template_dir'},
225          }          );
         close(TEMPLATE);  
226    
227          $log->info("creating '$html_file' with tree");          my $var = {
228                    js => $args->{'dir'}.'/'.$args->{'js'},
229                    tree => $html,
230            };
231    
232          my $js_arr_file = $args->{'js'};          $log->info("creating '$html_file' with tree from ",$args->{'template_tree'});
         $tmpl =~ s/\[%\s+js\s+%\]/$js_arr_file/gi;  
         $tmpl =~ s/\[%\s+tree\s+%\]/$html/gi;  
233    
234          open(HTML, ">", $html_file) || $log->logdie("can't open '$html_file': $!");          $tt->process($args->{'template_tree'}, $var, $html_file) || $log->logdie("template error: ",$tt->error());
         print HTML $tmpl;  
         close(HTML);  
235    
236            my $js_file = $args->{'dir'}."/".$args->{'js'};
237            $log->info("creating '$js_file' with tree data");
238          $self->generate_js(          $self->generate_js(
239                  file => $args->{'dir'}."/".$args->{'js'},                  file => $js_file,
240          );          );
241    
242            if (! $args->{'nodes'}) {
243                    $log->warn("skipping node creation");
244                    return $self;
245            }
246    
247            foreach my $mfn (keys %{$self->{'node_html'}}) {
248    
249                    my $html_file = $args->{'dir'}."/".$args->{'nodes'}."/${mfn}.html";
250    
251                    $log->debug("creating tree node $html_file");
252    
253                    $var = {
254                            node => $self->{'node_html'}->{$mfn},
255                    };
256    
257                    $tt->process($args->{'template_node'}, $var, $html_file) || $log->logdie("template error: ",$tt->error());
258            }
259    
260          return $self;          return $self;
261  }  }
262    
# Line 227  Generate tree recursively. Line 271  Generate tree recursively.
271  sub unroll {  sub unroll {
272          my $self = shift;          my $self = shift;
273    
274          my ($level,$data_arr) = @_;          my ($level,$data_arr, $base_path) = @_;
275    
276            $base_path ||= '';
277    
278          my $log = $self->_get_logger();          my $log = $self->_get_logger();
279    
# Line 282  sub unroll { Line 328  sub unroll {
328    
329                          ($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);
330    
331                          my $mfn_link = "thes/$mfn.html";                          my $mfn_link;
332                          if (-e "out/$mfn_link") {                          $mfn_link = $self->{'detail_url'}->($mfn) if ($self->{'detail_url'});
333                                  $term =~ s# *\* *# <img src="img/crovoc.png" border="0">#;  
334                            if ($mfn_link) {
335                                    $term =~ s, *#C# *, <img src="${base_path}img/crovoc.png" border="0">,;
336                                  $html .= " " x $level .                                  $html .= " " x $level .
337                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
338                                          qq{&nbsp;<a href="$mfn_link" onClick="javascript:return popup(this);"><img src="img/listic.png" border="0"></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};
339                                    $log->debug("linked details to $mfn_link");
340                          } else {                          } else {
341                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");
342                          }                          }
# Line 313  sub unroll { Line 362  sub unroll {
362                                  push @{$self->{'show_ids'}}, "id$mfn";                                  push @{$self->{'show_ids'}}, "id$mfn";
363                          }                          }
364    
365                          $html .= $self->unroll($next_level, $have_children);                          if ($tree->[$level]->{'iframe'}) {
366                                                            # unroll to separate file
367                                    $self->{'node_html'}->{$mfn} = $self->unroll($next_level, $have_children, '../');
368    
369                            } else {
370                                    # unroll at base HTML
371                                    $html .= $self->unroll($next_level, $have_children, $base_path);
372                            }
373    
374                          $html .= " " x $level . qq{</ul>\n};                          $html .= " " x $level . qq{</ul>\n};
375    
376                  }                  }
Legend:
Removed from v.530  
changed lines
  Added in v.573
  ViewVC Help
Powered by ViewVC 1.1.26