/[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 460 by dpavlin, Tue Sep 21 20:43:43 2004 UTC revision 530 by dpavlin, Tue Oct 19 17:43:52 2004 UTC
# Line 114  above) to stop recursion. Line 114  above) to stop recursion.
114  Create new tree object  Create new tree object
115    
116   my $tree = new WebPAC::Tree(   my $tree = new WebPAC::Tree(
         dir => './out',  
         html => 'browse.html',  
         template => './output_template/tree.tt',  
         js => 'tree-ids.js',  
117          tree => \@tree,          tree => \@tree,
118          log => 'log4perl.conf',          log => 'log4perl.conf',
119   );   );
120    
 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.  
   
121  C<tree> is tree array with levels of tree described above.  C<tree> is tree array with levels of tree described above.
122    
123  C<log> is optional parametar which specify filename of L<Log::Log4Perl>  C<log> is optional parametar which specify filename of L<Log::Log4Perl>
# Line 149  sub new { Line 135  sub new {
135    
136          my $log = $self->_get_logger();          my $log = $self->_get_logger();
137    
138          foreach my $p (qw(dir html template js tree)) {          $log->logconfess("need tree") unless ($self->{'tree'});
                 $log->logconfess("need $p") unless ($self->{$p});  
         }  
139    
140          $self->{'show_ids'} = [];          $self->{'show_ids'} = [];
141          $self->{'hide_ids'} = [];          $self->{'hide_ids'} = [];
142    
143          my $html = $self->unroll(0,());          $self->{'tree_html'} = $self->unroll(0,());
144    
145            if (! $self->{'tree_html'}) {
146                    $log->warn("no html generated by unroll...");
147                    return;
148            }
149    
150            return $self;
151    }
152    
153          my $html_file = $self->{'dir'}.'/'.$self->{'html'};  =head2 output
154    
155          open(TEMPLATE, $self->{'template'}) || $log->logdie("can't open '",$self->{'template'},": $!");  Create output files from tree object
156    
157     $tree->output(
158            dir => './out',
159            html => 'browse.html',
160            template => './output_template/tree.tt',
161            js => 'tree-ids.js',
162     );
163    
164    C<dir> is output directory in which html files and JavaScript files will be
165    created (think of it as C<public_html>).
166    
167    C<html> is name of output html file.
168    
169    C<template> is name of template. It uses Template Toolkit syntax [% var %],
170    but doesn't really use TT.
171    
172    C<js> is name of JavaScript file with shown and hidden ids.
173    
174    =cut
175    
176    sub output {
177            my $self = shift;
178    
179            my $args = {@_};
180    
181            my $log = $self->_get_logger();
182    
183            foreach my $p (qw(dir html template js)) {
184                    $log->logconfess("need $p") unless ($args->{$p});
185            }
186    
187            my $html = $self->{'tree_html'};
188            unless ($html) {
189                    $log->warn("no html, output aborted");
190                    return;
191            }
192    
193            my $html_file = $args->{'dir'}.'/'.$args->{'html'};
194    
195            open(TEMPLATE, $args->{'template'}) || $log->logdie("can't open '",$args->{'template'},": $!");
196          my $tmpl;          my $tmpl;
197          while(<TEMPLATE>) {          while(<TEMPLATE>) {
198                  $tmpl .= $_;                  $tmpl .= $_;
# Line 169  sub new { Line 201  sub new {
201    
202          $log->info("creating '$html_file' with tree");          $log->info("creating '$html_file' with tree");
203    
204          my $js_arr_file = $self->{'js'};          my $js_arr_file = $args->{'js'};
205          $tmpl =~ s/\[%\s+js\s+%\]/$js_arr_file/gi;          $tmpl =~ s/\[%\s+js\s+%\]/$js_arr_file/gi;
206          $tmpl =~ s/\[%\s+tree\s+%\]/$html/gi;          $tmpl =~ s/\[%\s+tree\s+%\]/$html/gi;
207    
# Line 177  sub new { Line 209  sub new {
209          print HTML $tmpl;          print HTML $tmpl;
210          close(HTML);          close(HTML);
211    
212          $self->generate_js();          $self->generate_js(
213                    file => $args->{'dir'}."/".$args->{'js'},
214            );
215    
216          return $self;          return $self;
217  }  }
# Line 227  sub unroll { Line 261  sub unroll {
261                          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;
262                          $log->debug("# $level lookup_v900($code) = $v900");                          $log->debug("# $level lookup_v900($code) = $v900");
263    
264                          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;
265                          $log->debug("# $level lookup_term($code,$v900) = $term");                          $log->debug("# $level lookup_term($code,$v900) = $term");
266    
267                          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;
268                          $log->debug("# $level lookup_mfn($code,$v900) = $mfn");                          $log->debug("# $level lookup_mfn($code,$v900) = $mfn");
269    
270                          $log->debug("$code -> $v900 : $term [$mfn]");                          $log->debug("$code -> $v900 : $term [$mfn]");
# Line 250  sub unroll { Line 284  sub unroll {
284    
285                          my $mfn_link = "thes/$mfn.html";                          my $mfn_link = "thes/$mfn.html";
286                          if (-e "out/$mfn_link") {                          if (-e "out/$mfn_link") {
287                                    $term =~ s# *\* *# <img src="img/crovoc.png" border="0">#;
288                                  $html .= " " x $level .                                  $html .= " " x $level .
289                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.                                          qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
290                                          qq{&nbsp;<a href="$mfn_link">&raquo;</a></li>\n};                                          qq{&nbsp;<a href="$mfn_link" onClick="javascript:return popup(this);"><img src="img/listic.png" border="0"></a></li>\n};
291                          } else {                          } else {
292                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");                                  $log->warn("file 'out/$mfn_link' doesn't exist, skipping");
293                          }                          }
# Line 263  sub unroll { Line 298  sub unroll {
298                          my $style = $tree->[$level]->{'style'};                          my $style = $tree->[$level]->{'style'};
299    
300                          $html .= " " x $level .                          $html .= " " x $level .
301                                  qq{<a name="mfn$mfn"></a>\n <ul id="id$mfn"}.                                  qq{<ul id="id$mfn"}.
302                                  ($style ? ' style="'.$style.'"' : '').                                  ($style ? ' style="'.$style.'"' : '').
303                                  qq{>\n};                                  qq{>\n};
304    
# Line 292  sub unroll { Line 327  sub unroll {
327  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
328  elements.  elements.
329    
330   $tree->generate_js();   $tree->generate_js(
331            file = "./out/tree-ids.js",
332     );
333    
334  =cut  =cut
335    
336  sub generate_js {  sub generate_js {
337          my $self = shift;          my $self = shift;
338    
339            my $args = {@_};
340    
341          my $log = $self->_get_logger();          my $log = $self->_get_logger();
342    
343          my $js_file = $self->{'dir'}.'/'.$self->{'js'};          my $js_file = $args->{'file'};
344            $log->die("need file") unless ($args->{'file'});
345    
346          $log->info("creating '$js_file' with arrays of shown and hidden ids");          $log->info("creating '$js_file' with arrays of shown and hidden ids");
347    
Legend:
Removed from v.460  
changed lines
  Added in v.530
  ViewVC Help
Powered by ViewVC 1.1.26