lib/WebPAC/Tree.pm

package WebPAC::Tree;

use warnings;
use strict;

use Carp;
use Log::Log4perl qw(get_logger :levels);
use YAML;
use Template;

=head1 NAME

WebPAC::Tree - create tree from lookup data

=head1 DESCRIPTION

This module will create tree from lookup data. It requires quite complicated
data structure, but once you get hang of that, it's peace of cake :-)

Data structure for tree definition is non-recursive, and defines each level
of tree individually (so you can limit depth of tree) like this:

 my $l = $webpac->{'lookup'};

 my @tree = ({
        # level 0
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub {
                                my ($c,$p) = @_;
                                $p =~ s/^a:(..:....):.*$/$1/;
                                return "a:".$p.":".$c;
                        },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { return $l->{$_[1]} },
        iframe          => 1,
        },{
        # level 1
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub {
                                my ($c,$p) = @_;
                                $p =~ s/^a:(..:....):.*$/$1/;
                                return "a:".$p.":".$c;
                        },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { 0 },
        style           => 'display: none',
 )};

You can, however, create recursion with C<have_children_at_level> discussed
below, but you loose ability to limit tree depth or to specify different
style for each level.

Documentation for each element of tree is little sparse, but here it is:

=over 5

=item code_arr

Called once for each level.

 @mfns = $t->{'code_arr'}->($start_code);

Returns codes for this level.

=item filter_code

Optional function (which can be replaced by C<shift>) to filter which codes
are displayed.

 $t->{'filter_code'}->($code);

Returns code or C<false> if code has to be skipped.

=item lookup_v900

Lookup value which will be called C<$v900> from now on.

 my $v900 = $t->{'lookup_v900'}->($code);

=item lookup_term

Lookup term value, displayed as name of tree element.

 my $term = $t->{'lookup_term'}->($code,$v900);

=item lookup_mfn

Lookup mfn value, used to create hyperlink from tree.

 my $mfn = $t->{'lookup_mfn'}->($code,$v900);

=item have_children

Returns children for next iteration of tree generation or undef.

 my $next_lvl = $t->{'have_children'}->($code,$v900);

=item have_children_at_level

Returns children for next iteration and next level.

 my ($level,$next_lvl) = $t->{'have_children_at_level'}->($code,$v900);

It's safe to return undef just for next level data (C<$next_lvl> in example
above) to stop recursion.

=item iframe

This optional option will create all children nodes in separate file, and iframe in tree html,
so that generated tee html will have resonable size with large number of nodes.

=item style

Optional option to specify style of this node.

=back

=head1 METHODS

=head2 new

Create new tree object

 my $tree = new WebPAC::Tree(
        tree => \@tree,
        log => 'log4perl.conf',
        detail_url => sub {
                my $mfn = shift;
                my $path = "thes/${mfn}.html";
                return $path if (-e "./out/$path");
        },
        iframe_base => '../',
 );

C<tree> is tree array with levels of tree described above.

C<log> is optional parametar which specify filename of L<Log::Log4Perl>
config file. Default is C<log.conf>.

C<detail_url> code ref to check if detail html exists (and return URL if
it does).

C<iframe_base> is relative path from C<dir> defiend in C<output> to root
(which is inserted in all html).

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        my $log_file = $self->{'log'} || "log.conf";
        Log::Log4perl->init($log_file);

        my $log = $self->_get_logger();

        $log->logconfess("need tree") unless ($self->{'tree'});

        $self->{'show_ids'} = [];
        $self->{'hide_ids'} = [];

        $self->{'tree_html'} = $self->unroll(0,());

        if (! $self->{'tree_html'}) {
                $log->warn("no html generated by unroll...");
                return;
        }

        return $self;
}

=head2 output

Create output files from tree object

 $tree->output(
        dir => './out',
        html => 'browse.html',
        template_dir => './output_template/',
        template_tree => 'tree.tt',
        template_node => 'node.tt',
        nodes => 'nodes',
        js => 'tree-ids.js',
 );

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_dir> is directory with Template Toolkit templates.

C<template_tree> is name of template to produce tree.

C<template_node> is (optional) name of template for node (if C<iframe>
options is used within tree definition).

C<nodes> is directory in C<dir> in which html for iframes will be located.
See also C<iframe_base> for relative dir out of this directory.

C<js> is name of JavaScript file with shown and hidden ids.

=cut

sub output {
        my $self = shift;

        my $args = {@_};

        my $log = $self->_get_logger();

        foreach my $p (qw(dir html template_dir template_tree js)) {
                $log->logconfess("need $p") unless ($args->{$p});
        }

        my $html = $self->{'tree_html'};
        unless ($html) {
                $log->warn("no html, output aborted");
                return;
        }

        my $html_file = $args->{'dir'}.'/'.$args->{'html'};

        $log->debug("templates are in ",$args->{'template_dir'});

        my $tt = Template->new(
                INCLUDE_PATH => $args->{'template_dir'},
        );

        my $var = {
                js => $args->{'dir'}.'/'.$args->{'js'},
                tree => $html,
        };

        $log->info("creating '$html_file' with tree from ",$args->{'template_tree'});

        $tt->process($args->{'template_tree'}, $var, $html_file) || $log->logdie("template error: ",$tt->error());

        my $js_file = $args->{'dir'}."/".$args->{'js'};
        $log->info("creating '$js_file' with tree data");
        $self->generate_js(
                file => $js_file,
        );

        if (! $args->{'nodes'}) {
                $log->warn("skipping node creation");
                return $self;
        }

        foreach my $mfn (keys %{$self->{'node_html'}}) {

                my $html_file = $args->{'dir'}."/".$args->{'nodes'}."/${mfn}.html";

                $log->debug("creating tree node $html_file");

                $var = {
                        node => $self->{'node_html'}->{$mfn},
                };

                $tt->process($args->{'template_node'}, $var, $html_file) || $log->logdie("template error: ",$tt->error());
        }

        return $self;
}

=head2 unroll

Generate tree recursively.

 my $html = $tree->unroll($level,$data_arr);

=cut

sub unroll {
        my $self = shift;

        my ($level,$data_arr, $base_path) = @_;

        $base_path ||= '';

        my $log = $self->_get_logger();

        if (! defined($level)) {
                $log->warn("level is undef, stoping recursion...");
                return;
        }

        my $next_level = $level + 1;

        $log->logconfess("need level") unless (defined($level));
        #$log->logconfess("need data_arr") unless (defined($data_arr));

        my $tree = $self->{'tree'};

        $log->logconfess("tree is not defined") unless (defined($tree));

        # all levels passed?
        return if (! defined($tree->[$level]));

        $log->debug("unroll level $level");

        my $html;

        foreach my $code ($tree->[$level]->{'code_arr'}->($data_arr)) {

                if ($code = $tree->[$level]->{'filter_code'}->($code)) {
                
                        $log->debug("# $level filter passed code $code");

                        my $v900 = $tree->[$level]->{'lookup_v900'}->($code) || $log->warn("can't lookup_v900($code)") && return;
                        $log->debug("# $level lookup_v900($code) = $v900");

                        my $term = $tree->[$level]->{'lookup_term'}->($code,$v900) || $log->warn("can't lookup_term($code,$v900)") && next;
                        $log->debug("# $level lookup_term($code,$v900) = $term");

                        my $mfn  = $tree->[$level]->{'lookup_mfn'}->($code,$v900)  || $log->warn("can't lookup_mfn($code,$v900)") && next;
                        $log->debug("# $level lookup_mfn($code,$v900) = $mfn");

                        $log->debug("$code -> $v900 : $term [$mfn]");

                        my ($link_start,$link_end) = ('','');
        
                        my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);

                        if (! $have_children) {
                                $log->debug("# $level doesn't have_children($code,$v900)");
                                ($next_level,$have_children) = $tree->[$level]->{'have_children_at_level'}->($code,$v900) if ($tree->[$level]->{'have_children_at_level'});
                                $log->debug("# $level have_children($code,$v900) on level $next_level") if ($have_children);

                        }

                        ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);

                        my $mfn_link;
                        $mfn_link = $self->{'detail_url'}->($mfn) if ($self->{'detail_url'});

                        if ($mfn_link) {
                                $term =~ s/ *#C# */ <img src="${base_path}img\/crovoc.png" border="0">/;
                                $html .= " " x $level .
                                        qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
                                        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};
                                $log->debug("linked details to $mfn_link");
                        } else {
                                $log->warn("file 'out/$mfn_link' doesn't exist, skipping");
                        }

                        # save mfn for iframe
                        push @{$self->{'mfn_arr'}}, $mfn;

                        unless ($have_children) {
                                next;
                        }
                        my $style = $tree->[$level]->{'style'};

                        $html .= " " x $level .
                                qq{<ul id="id$mfn"}.
                                ($style ? ' style="'.$style.'"' : '').
                                qq{>\n};

                        if ($style) {
                                if ($style =~ m/display\s*:\s*none/i) {
                                        push @{$self->{'hide_ids'}}, "id$mfn";
                                } else {
                                        push @{$self->{'show_ids'}}, "id$mfn";
                                }
                        } else {
                                # default: show
                                push @{$self->{'show_ids'}}, "id$mfn";
                        }


                        if ($tree->[$level]->{'iframe'}) {

                                # reset list of current mfns
                                $self->{'mfn_arr'} = ();

                                # unroll to separate file
                                $self->{'node_html'}->{$mfn} = $self->unroll($next_level, $have_children, $self->{'iframe_base'});
                                $html .= " " x $level .
                                qq{<iframe id="i$mfn" name="i$mfn" width="100%" height="10" frameborder="0" border="0"></iframe>};
                                @{$self->{'iframe_mfn'}->{$mfn}} = @{$self->{'mfn_arr'}};
                                $log->debug("in this iframe: ", sub { Dump($self->{'iframe_mfn'}->{$mfn}) });

                        } else {
                                # unroll at base HTML
                                $html .= $self->unroll($next_level, $have_children, $base_path);
                        }

                        $html .= " " x $level . qq{</ul>\n};

                }
        }
        return $html;
}

=head2 generate_js

Generate JavaScript arrays C<show> and C<hide> used to toggle display of
elements.

 $tree->generate_js(
        file = "./out/tree-ids.js",
 );

=cut

sub generate_js {
        my $self = shift;

        my $args = {@_};

        my $log = $self->_get_logger();

        my $js_file = $args->{'file'};
        $log->die("need file") unless ($args->{'file'});

        $log->info("creating '$js_file' with arrays of shown and hidden ids");

        open(JS, ">", $js_file) || $log->logdie("can't open '$js_file': $!");
        print JS "var show = ['",join("','",@{$self->{'show_ids'}}),"'];\n";
        print JS "var hide = ['",join("','",@{$self->{'hide_ids'}}),"'];\n";

        print JS "var mfn_iframe = [\n";
        foreach my $if (keys %{$self->{'iframe_mfn'}}) {
                print JS " ",join(",",map { "[$_:$if]" } @{$self->{'iframe_mfn'}->{$if}}),",\n";
        }
        print JS " null\n]\n";

        close(JS);

        $log->debug("stored ",scalar @{$self->{'show_ids'}}," shown and ",scalar @{$self->{'hide_ids'}}," hidden elements");

}

#

=head1 INTERNAL METHODS

You shouldn't call this methods directly.

=head2 _get_logger

Get C<Log::Log4perl> object with a twist: domains are defined for each
method

 my $log = $webpac->_get_logger();

=cut

sub _get_logger {
        my $self = shift;

        my $name = (caller(1))[3] || caller;
        return get_logger($name);
}

1;
1	dpavlin	441	package WebPAC::Tree;
2
3			use warnings;
4			use strict;
5
6			use Carp;
7			use Log::Log4perl qw(get_logger :levels);
8	dpavlin	460	use YAML;
9	dpavlin	572	use Template;
10	dpavlin	441
11			=head1 NAME
12
13			WebPAC::Tree - create tree from lookup data
14
15			=head1 DESCRIPTION
16
17			This module will create tree from lookup data. It requires quite complicated
18	dpavlin	572	data structure, but once you get hang of that, it's peace of cake :-)
19	dpavlin	441
20			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:
22
23			my $l = $webpac->{'lookup'};
24
25			my @tree = ({
26			# level 0
27	dpavlin	454	code_arr => sub { @{$_[0]} },
28	dpavlin	441	filter_code => sub { shift },
29			lookup_v900 => sub {
30			my ($c,$p) = @_;
31			$p =~ s/^a:(..:....):.*$/$1/;
32			return "a:".$p.":".$c;
33			},
34			lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
35			lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
36	dpavlin	454	have_children => sub { return $l->{$_[1]} },
37	dpavlin	572	iframe => 1,
38	dpavlin	441	},{
39			# level 1
40	dpavlin	454	code_arr => sub { @{$_[0]} },
41	dpavlin	441	filter_code => sub { shift },
42			lookup_v900 => sub {
43			my ($c,$p) = @_;
44			$p =~ s/^a:(..:....):.*$/$1/;
45			return "a:".$p.":".$c;
46			},
47			lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
48			lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
49			have_children => sub { 0 },
50	dpavlin	572	style => 'display: none',
51	dpavlin	441	)};
52
53	dpavlin	454	You can, however, create recursion with C<have_children_at_level> discussed
54			below, but you loose ability to limit tree depth or to specify different
55			style for each level.
56
57	dpavlin	441	Documentation for each element of tree is little sparse, but here it is:
58
59			=over 5
60
61			=item code_arr
62
63			Called once for each level.
64
65			@mfns = $t->{'code_arr'}->($start_code);
66
67			Returns codes for this level.
68
69			=item filter_code
70
71			Optional function (which can be replaced by C<shift>) to filter which codes
72			are displayed.
73
74			$t->{'filter_code'}->($code);
75
76			Returns code or C<false> if code has to be skipped.
77
78			=item lookup_v900
79
80			Lookup value which will be called C<$v900> from now on.
81
82	dpavlin	460	my $v900 = $t->{'lookup_v900'}->($code);
83	dpavlin	441
84			=item lookup_term
85
86			Lookup term value, displayed as name of tree element.
87
88			my $term = $t->{'lookup_term'}->($code,$v900);
89
90			=item lookup_mfn
91
92			Lookup mfn value, used to create hyperlink from tree.
93
94			my $mfn = $t->{'lookup_mfn'}->($code,$v900);
95
96			=item have_children
97
98	dpavlin	454	Returns children for next iteration of tree generation or undef.
99	dpavlin	441
100	dpavlin	460	my $next_lvl = $t->{'have_children'}->($code,$v900);
101	dpavlin	441
102	dpavlin	454	=item have_children_at_level
103	dpavlin	441
104	dpavlin	454	Returns children for next iteration and next level.
105	dpavlin	441
106	dpavlin	460	my ($level,$next_lvl) = $t->{'have_children_at_level'}->($code,$v900);
107	dpavlin	441
108	dpavlin	454	It's safe to return undef just for next level data (C<$next_lvl> in example
109			above) to stop recursion.
110
111	dpavlin	572	=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	dpavlin	441	=back
121
122			=head1 METHODS
123
124			=head2 new
125
126			Create new tree object
127
128			my $tree = new WebPAC::Tree(
129			tree => \@tree,
130			log => 'log4perl.conf',
131	dpavlin	573	detail_url => sub {
132			my $mfn = shift;
133	dpavlin	574	my $path = "thes/${mfn}.html";
134			return $path if (-e "./out/$path");
135	dpavlin	573	},
136	dpavlin	574	iframe_base => '../',
137	dpavlin	441	);
138
139			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>
142			config file. Default is C<log.conf>.
143
144	dpavlin	573	C<detail_url> code ref to check if detail html exists (and return URL if
145			it does).
146
147	dpavlin	574	C<iframe_base> is relative path from C<dir> defiend in C<output> to root
148			(which is inserted in all html).
149
150	dpavlin	441	=cut
151
152			sub new {
153			my $class = shift;
154			my $self = {@_};
155			bless($self, $class);
156
157			my $log_file = $self->{'log'} \|\| "log.conf";
158			Log::Log4perl->init($log_file);
159
160			my $log = $self->_get_logger();
161
162	dpavlin	530	$log->logconfess("need tree") unless ($self->{'tree'});
163	dpavlin	441
164			$self->{'show_ids'} = [];
165			$self->{'hide_ids'} = [];
166
167	dpavlin	530	$self->{'tree_html'} = $self->unroll(0,());
168	dpavlin	441
169	dpavlin	530	if (! $self->{'tree_html'}) {
170	dpavlin	492	$log->warn("no html generated by unroll...");
171			return;
172			}
173	dpavlin	471
174	dpavlin	530	return $self;
175			}
176	dpavlin	441
177	dpavlin	530	=head2 output
178
179			Create output files from tree object
180
181			$tree->output(
182			dir => './out',
183			html => 'browse.html',
184	dpavlin	572	template_dir => './output_template/',
185			template_tree => 'tree.tt',
186			template_node => 'node.tt',
187	dpavlin	574	nodes => 'nodes',
188	dpavlin	530	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	dpavlin	572	C<template_dir> is directory with Template Toolkit templates.
197	dpavlin	530
198	dpavlin	572	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	dpavlin	574	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	dpavlin	530	C<js> is name of JavaScript file with shown and hidden ids.
207
208			=cut
209
210			sub output {
211			my $self = shift;
212
213			my $args = {@_};
214
215			my $log = $self->_get_logger();
216
217	dpavlin	572	foreach my $p (qw(dir html template_dir template_tree js)) {
218	dpavlin	530	$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			}
226
227			my $html_file = $args->{'dir'}.'/'.$args->{'html'};
228
229	dpavlin	572	$log->debug("templates are in ",$args->{'template_dir'});
230	dpavlin	441
231	dpavlin	572	my $tt = Template->new(
232			INCLUDE_PATH => $args->{'template_dir'},
233			);
234	dpavlin	441
235	dpavlin	572	my $var = {
236			js => $args->{'dir'}.'/'.$args->{'js'},
237			tree => $html,
238			};
239	dpavlin	441
240	dpavlin	572	$log->info("creating '$html_file' with tree from ",$args->{'template_tree'});
241	dpavlin	441
242	dpavlin	572	$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	dpavlin	530	$self->generate_js(
247	dpavlin	572	file => $js_file,
248	dpavlin	530	);
249	dpavlin	441
250	dpavlin	572	if (! $args->{'nodes'}) {
251			$log->warn("skipping node creation");
252			return $self;
253			}
254
255			foreach my $mfn (keys %{$self->{'node_html'}}) {
256
257			my $html_file = $args->{'dir'}."/".$args->{'nodes'}."/${mfn}.html";
258
259			$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	dpavlin	441	return $self;
269			}
270
271			=head2 unroll
272
273			Generate tree recursively.
274
275	dpavlin	460	my $html = $tree->unroll($level,$data_arr);
276	dpavlin	441
277			=cut
278
279			sub unroll {
280			my $self = shift;
281
282	dpavlin	573	my ($level,$data_arr, $base_path) = @_;
283	dpavlin	441
284	dpavlin	573	$base_path \|\|= '';
285
286	dpavlin	455	my $log = $self->_get_logger();
287
288			if (! defined($level)) {
289			$log->warn("level is undef, stoping recursion...");
290			return;
291			}
292
293	dpavlin	454	my $next_level = $level + 1;
294
295	dpavlin	441	$log->logconfess("need level") unless (defined($level));
296	dpavlin	460	#$log->logconfess("need data_arr") unless (defined($data_arr));
297	dpavlin	441
298			my $tree = $self->{'tree'};
299
300			$log->logconfess("tree is not defined") unless (defined($tree));
301
302			# all levels passed?
303			return if (! defined($tree->[$level]));
304
305	dpavlin	460	$log->debug("unroll level $level");
306	dpavlin	441
307			my $html;
308
309	dpavlin	460	foreach my $code ($tree->[$level]->{'code_arr'}->($data_arr)) {
310	dpavlin	441
311			if ($code = $tree->[$level]->{'filter_code'}->($code)) {
312
313			$log->debug("# $level filter passed code $code");
314
315	dpavlin	460	my $v900 = $tree->[$level]->{'lookup_v900'}->($code) \|\| $log->warn("can't lookup_v900($code)") && return;
316			$log->debug("# $level lookup_v900($code) = $v900");
317	dpavlin	441
318	dpavlin	471	my $term = $tree->[$level]->{'lookup_term'}->($code,$v900) \|\| $log->warn("can't lookup_term($code,$v900)") && next;
319	dpavlin	441	$log->debug("# $level lookup_term($code,$v900) = $term");
320
321	dpavlin	471	my $mfn = $tree->[$level]->{'lookup_mfn'}->($code,$v900) \|\| $log->warn("can't lookup_mfn($code,$v900)") && next;
322	dpavlin	441	$log->debug("# $level lookup_mfn($code,$v900) = $mfn");
323
324			$log->debug("$code -> $v900 : $term [$mfn]");
325
326	dpavlin	472	my ($link_start,$link_end) = ('','');
327	dpavlin	441
328	dpavlin	460	my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);
329	dpavlin	454
330			if (! $have_children) {
331	dpavlin	460	$log->debug("# $level doesn't have_children($code,$v900)");
332			($next_level,$have_children) = $tree->[$level]->{'have_children_at_level'}->($code,$v900) if ($tree->[$level]->{'have_children_at_level'});
333			$log->debug("# $level have_children($code,$v900) on level $next_level") if ($have_children);
334	dpavlin	454
335	dpavlin	441	}
336
337	dpavlin	454	($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);
338
339	dpavlin	573	my $mfn_link;
340			$mfn_link = $self->{'detail_url'}->($mfn) if ($self->{'detail_url'});
341
342			if ($mfn_link) {
343	dpavlin	574	$term =~ s/ #C# / <img src="${base_path}img\/crovoc.png" border="0">/;
344	dpavlin	441	$html .= " " x $level .
345	dpavlin	499	qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
346	dpavlin	573	qq{ <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	dpavlin	441	} else {
349			$log->warn("file 'out/$mfn_link' doesn't exist, skipping");
350			}
351
352	dpavlin	574	# save mfn for iframe
353			push @{$self->{'mfn_arr'}}, $mfn;
354
355	dpavlin	441	unless ($have_children) {
356			next;
357			}
358			my $style = $tree->[$level]->{'style'};
359
360			$html .= " " x $level .
361	dpavlin	472	qq{<ul id="id$mfn"}.
362	dpavlin	441	($style ? ' style="'.$style.'"' : '').
363			qq{>\n};
364
365			if ($style) {
366			if ($style =~ m/display\s:\snone/i) {
367			push @{$self->{'hide_ids'}}, "id$mfn";
368			} else {
369			push @{$self->{'show_ids'}}, "id$mfn";
370			}
371			} else {
372			# default: show
373			push @{$self->{'show_ids'}}, "id$mfn";
374			}
375
376	dpavlin	574
377	dpavlin	572	if ($tree->[$level]->{'iframe'}) {
378	dpavlin	574
379			# reset list of current mfns
380			$self->{'mfn_arr'} = ();
381
382	dpavlin	572	# unroll to separate file
383	dpavlin	574	$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	dpavlin	572
389			} else {
390			# unroll at base HTML
391	dpavlin	573	$html .= $self->unroll($next_level, $have_children, $base_path);
392	dpavlin	572	}
393
394	dpavlin	441	$html .= " " x $level . qq{</ul>\n};
395
396			}
397			}
398			return $html;
399			}
400
401			=head2 generate_js
402
403			Generate JavaScript arrays C<show> and C<hide> used to toggle display of
404			elements.
405
406	dpavlin	530	$tree->generate_js(
407			file = "./out/tree-ids.js",
408			);
409	dpavlin	441
410			=cut
411
412			sub generate_js {
413			my $self = shift;
414
415	dpavlin	530	my $args = {@_};
416
417	dpavlin	441	my $log = $self->_get_logger();
418
419	dpavlin	530	my $js_file = $args->{'file'};
420			$log->die("need file") unless ($args->{'file'});
421	dpavlin	441
422			$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': $!");
425			print JS "var show = ['",join("','",@{$self->{'show_ids'}}),"'];\n";
426			print JS "var hide = ['",join("','",@{$self->{'hide_ids'}}),"'];\n";
427	dpavlin	574
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	dpavlin	441	close(JS);
435
436	dpavlin	442	$log->debug("stored ",scalar @{$self->{'show_ids'}}," shown and ",scalar @{$self->{'hide_ids'}}," hidden elements");
437	dpavlin	441
438			}
439
440			#
441
442			=head1 INTERNAL METHODS
443
444			You shouldn't call this methods directly.
445
446			=head2 _get_logger
447
448			Get C<Log::Log4perl> object with a twist: domains are defined for each
449			method
450
451			my $log = $webpac->_get_logger();
452
453			=cut
454
455			sub _get_logger {
456			my $self = shift;
457
458			my $name = (caller(1))[3] \|\| caller;
459			return get_logger($name);
460			}
461
462			1;