/[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 580 by dpavlin, Mon Nov 1 22:52:44 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 = "thes/${mfn}.html";
134                    return $path if (-e "./out/$path");
135            },
136            nodes_dir => 'nodes',
137   );   );
138    
139  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 141  C<tree> is tree array with levels of tre
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<nodes_dir> is relative path from output directory where tree nodes for
148    iframes will be created.
149    
150  =cut  =cut
151    
152  sub new {  sub new {
# Line 140  sub new { Line 164  sub new {
164          $self->{'show_ids'} = [];          $self->{'show_ids'} = [];
165          $self->{'hide_ids'} = [];          $self->{'hide_ids'} = [];
166    
167            # figure out relative URL to other content from nodes_dir
168            my $iframe_base = $self->{'nodes_dir'};
169            if ($iframe_base) {
170                    $iframe_base = s#[^/]*##g;
171                    $iframe_base = '../' x ( length($iframe_base) );
172                    $self->{'iframe_base'} = $iframe_base;
173                    $log->debug("nodes dir is '",$self->{'nodes_dir'},"' so iframe_base is '",$self->{'iframe_base'},"'");
174            }
175    
176          $self->{'tree_html'} = $self->unroll(0,());          $self->{'tree_html'} = $self->unroll(0,());
177    
178          if (! $self->{'tree_html'}) {          if (! $self->{'tree_html'}) {
# Line 157  Create output files from tree object Line 190  Create output files from tree object
190   $tree->output(   $tree->output(
191          dir => './out',          dir => './out',
192          html => 'browse.html',          html => 'browse.html',
193          template => './output_template/tree.tt',          template_dir => './output_template/',
194            template_tree => 'tree.tt',
195            template_node => 'node.tt',
196          js => 'tree-ids.js',          js => 'tree-ids.js',
197   );   );
198    
# Line 166  created (think of it as C<public_html>). Line 201  created (think of it as C<public_html>).
201    
202  C<html> is name of output html file.  C<html> is name of output html file.
203    
204  C<template> is name of template. It uses Template Toolkit syntax [% var %],  C<template_dir> is directory with Template Toolkit templates.
205  but doesn't really use TT.  
206    C<template_tree> is name of template to produce tree.
207    
208    C<template_node> is (optional) name of template for node (if C<iframe>
209    options is used within tree definition).
210    
211  C<js> is name of JavaScript file with shown and hidden ids.  C<js> is name of JavaScript file with shown and hidden ids.
212    
# Line 180  sub output { Line 219  sub output {
219    
220          my $log = $self->_get_logger();          my $log = $self->_get_logger();
221    
222          foreach my $p (qw(dir html template js)) {          foreach my $p (qw(dir html template_dir template_tree js)) {
223                  $log->logconfess("need $p") unless ($args->{$p});                  $log->logconfess("need $p") unless ($args->{$p});
224          }          }
225    
# Line 192  sub output { Line 231  sub output {
231    
232          my $html_file = $args->{'dir'}.'/'.$args->{'html'};          my $html_file = $args->{'dir'}.'/'.$args->{'html'};
233    
234          open(TEMPLATE, $args->{'template'}) || $log->logdie("can't open '",$args->{'template'},": $!");          $log->debug("templates are in ",$args->{'template_dir'});
235          my $tmpl;  
236          while(<TEMPLATE>) {          my $tt = Template->new(
237                  $tmpl .= $_;                  INCLUDE_PATH => $args->{'template_dir'},
238          }          );
         close(TEMPLATE);  
239    
240          $log->info("creating '$html_file' with tree");          my $var = {
241                    js => $args->{'dir'}.'/'.$args->{'js'},
242                    tree => $html,
243            };
244    
245          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;  
246    
247          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);  
248    
249            my $js_file = $args->{'dir'}."/".$args->{'js'};
250            $log->info("creating '$js_file' with tree data");
251          $self->generate_js(          $self->generate_js(
252                  file => $args->{'dir'}."/".$args->{'js'},                  file => $js_file,
253          );          );
254    
255            if (! $self->{'nodes_dir'}) {
256                    $log->warn("skipping node creation");
257                    return $self;
258            }
259    
260            foreach my $mfn (keys %{$self->{'node_html'}}) {
261    
262                    my $html_file = $args->{'dir'}."/".$self->{'nodes_dir'}."/${mfn}.html";
263    
264                    $log->debug("creating tree node $html_file");
265    
266                    $var = {
267                            node => $self->{'node_html'}->{$mfn},
268                    };
269    
270                    $tt->process($args->{'template_node'}, $var, $html_file) || $log->logdie("template error: ",$tt->error());
271            }
272    
273          return $self;          return $self;
274  }  }
275    
# Line 227  Generate tree recursively. Line 284  Generate tree recursively.
284  sub unroll {  sub unroll {
285          my $self = shift;          my $self = shift;
286    
287          my ($level,$data_arr) = @_;          my ($level,$data_arr, $base_path) = @_;
288    
289            $base_path ||= '';
290    
291          my $log = $self->_get_logger();          my $log = $self->_get_logger();
292    
# Line 248  sub unroll { Line 307  sub unroll {
307          # all levels passed?          # all levels passed?
308          return if (! defined($tree->[$level]));          return if (! defined($tree->[$level]));
309    
310          $log->debug("unroll level $level");          $log->debug("unroll level $level base path ",($base_path || "none"));
311    
312          my $html;          my $html;
313    
# Line 269  sub unroll { Line 328  sub unroll {
328    
329                          $log->debug("$code -> $v900 : $term [$mfn]");                          $log->debug("$code -> $v900 : $term [$mfn]");
330    
331                          my ($link_start,$link_end) = ('','');                          my ($link_start,$link_end,$level_el) = ('','','ul');
332                    
333                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);                          my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);
334    
# Line 280  sub unroll { Line 339  sub unroll {
339    
340                          }                          }
341    
342                          ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);                          my $iframe = $tree->[$level]->{'iframe'};
343    
344                            if ($have_children) {
345                                    ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>});
346                                    if ($iframe) {
347                                            my $url = $self->{'nodes_dir'} || $log->logdie("no nodes_dir?");
348                                            $url .= "/${mfn}.html";
349                                            $link_start = qq{<a href="#mfn$mfn" onClick="iframe_load('i$mfn','$url'); return toggle_display('id$mfn');">};
350                                            $level_el = 'div';
351                                    }
352                            }
353    
354                            my $mfn_link;
355                            $mfn_link = $self->{'detail_url'}->($mfn) if ($self->{'detail_url'});
356    
357                          my $mfn_link = "thes/$mfn.html";                          if ($mfn_link) {
358                          if (-e "out/$mfn_link") {                                  $term =~ s/ *#C# */ <img src="${base_path}img\/crovoc.png" border="0">/;
                                 $term =~ s# *\* *# <img src="img/crovoc.png" border="0">#;  
359                                  $html .= " " x $level .                                  $html .= " " x $level .
360                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
361                                          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};
362                                    $log->debug("linked details to $mfn_link");
363                          } else {                          } else {
364                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");
365                          }                          }
366    
367                            # save mfn for iframe
368                            push @{$self->{'mfn_arr'}}, $mfn;
369    
370                          unless ($have_children) {                          unless ($have_children) {
371                                  next;                                  next;
372                          }                          }
373                          my $style = $tree->[$level]->{'style'};                          my $style = $tree->[$level]->{'style'};
374    
375                          $html .= " " x $level .                          $html .= " " x $level .
376                                  qq{<ul id="id$mfn"}.                                  qq{<$level_el id="id$mfn"}.
377                                  ($style ? ' style="'.$style.'"' : '').                                  ($style ? ' style="'.$style.';"' : '').
378                                  qq{>\n};                                  qq{>\n};
379    
380                          if ($style) {                          if ($style) {
# Line 313  sub unroll { Line 388  sub unroll {
388                                  push @{$self->{'show_ids'}}, "id$mfn";                                  push @{$self->{'show_ids'}}, "id$mfn";
389                          }                          }
390    
391                          $html .= $self->unroll($next_level, $have_children);  
392                                                    if ($iframe) {
393                          $html .= " " x $level . qq{</ul>\n};  
394                                    # reset list of current mfns
395                                    $self->{'mfn_arr'} = ();
396    
397                                    # unroll to separate file
398                                    $self->{'node_html'}->{$mfn} = $self->unroll($next_level, $have_children, $self->{'iframe_base'});
399                                    $html .= " " x $level . qq{<span id="w$mfn" style="display: none;">Učitavanje podataka...</span>\n};
400    
401                                    $html .= " " x $level .
402                                    qq{<iframe id="i$mfn" name="i$mfn" width="100%" height="0" marginwidth="0" marginheight="0" frameborder="1" border="0" onLoad="iframe_resize(this.name);"></iframe>\n};
403                                    @{$self->{'iframe_mfn'}->{$mfn}} = @{$self->{'mfn_arr'}};
404    
405                            } else {
406                                    # unroll at base HTML
407                                    $html .= $self->unroll($next_level, $have_children, $base_path);
408                            }
409    
410                            $html .= " " x $level . qq{</$level_el>\n};
411    
412                  }                  }
413          }          }
# Line 348  sub generate_js { Line 440  sub generate_js {
440          open(JS, ">", $js_file) || $log->logdie("can't open '$js_file': $!");          open(JS, ">", $js_file) || $log->logdie("can't open '$js_file': $!");
441          print JS "var show = ['",join("','",@{$self->{'show_ids'}}),"'];\n";          print JS "var show = ['",join("','",@{$self->{'show_ids'}}),"'];\n";
442          print JS "var hide = ['",join("','",@{$self->{'hide_ids'}}),"'];\n";          print JS "var hide = ['",join("','",@{$self->{'hide_ids'}}),"'];\n";
443    
444            print JS "var mfn_iframe = [\n";
445            foreach my $if (keys %{$self->{'iframe_mfn'}}) {
446    #               print JS " ",join(",",map { "[$_:$if]" } @{$self->{'iframe_mfn'}->{$if}}),",\n";
447            }
448            print JS " null\n]\n";
449    
450          close(JS);          close(JS);
451    
452          $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.530  
changed lines
  Added in v.580
  ViewVC Help
Powered by ViewVC 1.1.26