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 = "./out/thes/${mfn}.html";
                return $path if (-e $path);
        },
 );

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).

=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',
        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<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");
                        }

                        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'}) {
                                # unroll to separate file
                                $self->{'node_html'}->{$mfn} = $self->unroll($next_level, $have_children, '../');

                        } 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";
        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			my $path = "./out/thes/${mfn}.html";
134			return $path if (-e $path);
135			},
136	dpavlin	441	);
137
138			C<tree> is tree array with levels of tree described above.
139
140			C<log> is optional parametar which specify filename of L<Log::Log4Perl>
141			config file. Default is C<log.conf>.
142
143	dpavlin	573	C<detail_url> code ref to check if detail html exists (and return URL if
144			it does).
145
146	dpavlin	441	=cut
147
148			sub new {
149			my $class = shift;
150			my $self = {@_};
151			bless($self, $class);
152
153			my $log_file = $self->{'log'} \|\| "log.conf";
154			Log::Log4perl->init($log_file);
155
156			my $log = $self->_get_logger();
157
158	dpavlin	530	$log->logconfess("need tree") unless ($self->{'tree'});
159	dpavlin	441
160			$self->{'show_ids'} = [];
161			$self->{'hide_ids'} = [];
162
163	dpavlin	530	$self->{'tree_html'} = $self->unroll(0,());
164	dpavlin	441
165	dpavlin	530	if (! $self->{'tree_html'}) {
166	dpavlin	492	$log->warn("no html generated by unroll...");
167			return;
168			}
169	dpavlin	471
170	dpavlin	530	return $self;
171			}
172	dpavlin	441
173	dpavlin	530	=head2 output
174
175			Create output files from tree object
176
177			$tree->output(
178			dir => './out',
179			html => 'browse.html',
180	dpavlin	572	template_dir => './output_template/',
181			template_tree => 'tree.tt',
182			template_node => 'node.tt',
183	dpavlin	530	js => 'tree-ids.js',
184			);
185
186			C<dir> is output directory in which html files and JavaScript files will be
187			created (think of it as C<public_html>).
188
189			C<html> is name of output html file.
190
191	dpavlin	572	C<template_dir> is directory with Template Toolkit templates.
192	dpavlin	530
193	dpavlin	572	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	dpavlin	530	C<js> is name of JavaScript file with shown and hidden ids.
199
200			=cut
201
202			sub output {
203			my $self = shift;
204
205			my $args = {@_};
206
207			my $log = $self->_get_logger();
208
209	dpavlin	572	foreach my $p (qw(dir html template_dir template_tree js)) {
210	dpavlin	530	$log->logconfess("need $p") unless ($args->{$p});
211			}
212
213			my $html = $self->{'tree_html'};
214			unless ($html) {
215			$log->warn("no html, output aborted");
216			return;
217			}
218
219			my $html_file = $args->{'dir'}.'/'.$args->{'html'};
220
221	dpavlin	572	$log->debug("templates are in ",$args->{'template_dir'});
222	dpavlin	441
223	dpavlin	572	my $tt = Template->new(
224			INCLUDE_PATH => $args->{'template_dir'},
225			);
226	dpavlin	441
227	dpavlin	572	my $var = {
228			js => $args->{'dir'}.'/'.$args->{'js'},
229			tree => $html,
230			};
231	dpavlin	441
232	dpavlin	572	$log->info("creating '$html_file' with tree from ",$args->{'template_tree'});
233	dpavlin	441
234	dpavlin	572	$tt->process($args->{'template_tree'}, $var, $html_file) \|\| $log->logdie("template error: ",$tt->error());
235
236			my $js_file = $args->{'dir'}."/".$args->{'js'};
237			$log->info("creating '$js_file' with tree data");
238	dpavlin	530	$self->generate_js(
239	dpavlin	572	file => $js_file,
240	dpavlin	530	);
241	dpavlin	441
242	dpavlin	572	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	dpavlin	441	return $self;
261			}
262
263			=head2 unroll
264
265			Generate tree recursively.
266
267	dpavlin	460	my $html = $tree->unroll($level,$data_arr);
268	dpavlin	441
269			=cut
270
271			sub unroll {
272			my $self = shift;
273
274	dpavlin	573	my ($level,$data_arr, $base_path) = @_;
275	dpavlin	441
276	dpavlin	573	$base_path \|\|= '';
277
278	dpavlin	455	my $log = $self->_get_logger();
279
280			if (! defined($level)) {
281			$log->warn("level is undef, stoping recursion...");
282			return;
283			}
284
285	dpavlin	454	my $next_level = $level + 1;
286
287	dpavlin	441	$log->logconfess("need level") unless (defined($level));
288	dpavlin	460	#$log->logconfess("need data_arr") unless (defined($data_arr));
289	dpavlin	441
290			my $tree = $self->{'tree'};
291
292			$log->logconfess("tree is not defined") unless (defined($tree));
293
294			# all levels passed?
295			return if (! defined($tree->[$level]));
296
297	dpavlin	460	$log->debug("unroll level $level");
298	dpavlin	441
299			my $html;
300
301	dpavlin	460	foreach my $code ($tree->[$level]->{'code_arr'}->($data_arr)) {
302	dpavlin	441
303			if ($code = $tree->[$level]->{'filter_code'}->($code)) {
304
305			$log->debug("# $level filter passed code $code");
306
307	dpavlin	460	my $v900 = $tree->[$level]->{'lookup_v900'}->($code) \|\| $log->warn("can't lookup_v900($code)") && return;
308			$log->debug("# $level lookup_v900($code) = $v900");
309	dpavlin	441
310	dpavlin	471	my $term = $tree->[$level]->{'lookup_term'}->($code,$v900) \|\| $log->warn("can't lookup_term($code,$v900)") && next;
311	dpavlin	441	$log->debug("# $level lookup_term($code,$v900) = $term");
312
313	dpavlin	471	my $mfn = $tree->[$level]->{'lookup_mfn'}->($code,$v900) \|\| $log->warn("can't lookup_mfn($code,$v900)") && next;
314	dpavlin	441	$log->debug("# $level lookup_mfn($code,$v900) = $mfn");
315
316			$log->debug("$code -> $v900 : $term [$mfn]");
317
318	dpavlin	472	my ($link_start,$link_end) = ('','');
319	dpavlin	441
320	dpavlin	460	my $have_children = $tree->[$level]->{'have_children'}->($code,$v900);
321	dpavlin	454
322			if (! $have_children) {
323	dpavlin	460	$log->debug("# $level doesn't have_children($code,$v900)");
324			($next_level,$have_children) = $tree->[$level]->{'have_children_at_level'}->($code,$v900) if ($tree->[$level]->{'have_children_at_level'});
325			$log->debug("# $level have_children($code,$v900) on level $next_level") if ($have_children);
326	dpavlin	454
327	dpavlin	441	}
328
329	dpavlin	454	($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>}) if ($have_children);
330
331	dpavlin	573	my $mfn_link;
332			$mfn_link = $self->{'detail_url'}->($mfn) if ($self->{'detail_url'});
333
334			if ($mfn_link) {
335			$term =~ s, #C# , <img src="${base_path}img/crovoc.png" border="0">,;
336	dpavlin	441	$html .= " " x $level .
337	dpavlin	499	qq{<li>${link_start}<span id="o$mfn">${term}</span>${link_end}}.
338	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};
339			$log->debug("linked details to $mfn_link");
340	dpavlin	441	} else {
341			$log->warn("file 'out/$mfn_link' doesn't exist, skipping");
342			}
343
344			unless ($have_children) {
345			next;
346			}
347			my $style = $tree->[$level]->{'style'};
348
349			$html .= " " x $level .
350	dpavlin	472	qq{<ul id="id$mfn"}.
351	dpavlin	441	($style ? ' style="'.$style.'"' : '').
352			qq{>\n};
353
354			if ($style) {
355			if ($style =~ m/display\s:\snone/i) {
356			push @{$self->{'hide_ids'}}, "id$mfn";
357			} else {
358			push @{$self->{'show_ids'}}, "id$mfn";
359			}
360			} else {
361			# default: show
362			push @{$self->{'show_ids'}}, "id$mfn";
363			}
364
365	dpavlin	572	if ($tree->[$level]->{'iframe'}) {
366			# unroll to separate file
367	dpavlin	573	$self->{'node_html'}->{$mfn} = $self->unroll($next_level, $have_children, '../');
368	dpavlin	572
369			} else {
370			# unroll at base HTML
371	dpavlin	573	$html .= $self->unroll($next_level, $have_children, $base_path);
372	dpavlin	572	}
373
374	dpavlin	441	$html .= " " x $level . qq{</ul>\n};
375
376			}
377			}
378			return $html;
379			}
380
381			=head2 generate_js
382
383			Generate JavaScript arrays C<show> and C<hide> used to toggle display of
384			elements.
385
386	dpavlin	530	$tree->generate_js(
387			file = "./out/tree-ids.js",
388			);
389	dpavlin	441
390			=cut
391
392			sub generate_js {
393			my $self = shift;
394
395	dpavlin	530	my $args = {@_};
396
397	dpavlin	441	my $log = $self->_get_logger();
398
399	dpavlin	530	my $js_file = $args->{'file'};
400			$log->die("need file") unless ($args->{'file'});
401	dpavlin	441
402			$log->info("creating '$js_file' with arrays of shown and hidden ids");
403
404			open(JS, ">", $js_file) \|\| $log->logdie("can't open '$js_file': $!");
405			print JS "var show = ['",join("','",@{$self->{'show_ids'}}),"'];\n";
406			print JS "var hide = ['",join("','",@{$self->{'hide_ids'}}),"'];\n";
407			close(JS);
408
409	dpavlin	442	$log->debug("stored ",scalar @{$self->{'show_ids'}}," shown and ",scalar @{$self->{'hide_ids'}}," hidden elements");
410	dpavlin	441
411			}
412
413			#
414
415			=head1 INTERNAL METHODS
416
417			You shouldn't call this methods directly.
418
419			=head2 _get_logger
420
421			Get C<Log::Log4perl> object with a twist: domains are defined for each
422			method
423
424			my $log = $webpac->_get_logger();
425
426			=cut
427
428			sub _get_logger {
429			my $self = shift;
430
431			my $name = (caller(1))[3] \|\| caller;
432			return get_logger($name);
433			}
434
435			1;