webpac/trunk2/all2all.pl

#!/usr/bin/perl -w

=head1 NAME

all2all.pl - basic script for all WebPAC needs

=cut

use strict;
use locale;
use YAML;
use Carp;
use Getopt::Long;
use Text::Unaccent 1.02;

use lib './lib';
use WebPAC;
use WebPAC::jsFind;
use WebPAC::Index;
use WebPAC::Tree;

# options which can be changed via command line
#
my $code_page = 'ISO-8859-2';
my ($limit_mfn, $start_mfn, $debug, $low_mem);
my $index_path = './out/index';

my $result = GetOptions(
        "code_page=s"   => \$code_page,
        "limit_mfn=i"   => \$limit_mfn,
        "start_mfn=i"   => \$start_mfn,
        "debug!"        => \$debug,
        "low_mem!"      => \$low_mem,
);

my $filter = {
        'CROVOC' => sub {
                my $tmp = shift || return;
                return undef unless ($tmp =~ s/\s*CROVOC.*$/ #C#/);
                # remove repeating stars
                # FIXME this should be fixed at right place, not here!
                $tmp =~ s/(\s*#C#)+/ #C#/g;
                return $tmp;
        },
        'CROVOC_tree' => sub {
                my $tmp = shift || return;
                $tmp =~ s/\s*CROVOC.*$/ <img src="img\/crovoc.png" border="0">/;
                $tmp =~ s/\s*EUROVOC.*//;
                return $tmp;
        },
        # TT filter
        'CROVOC_img' => sub {
                my $tmp = shift;
                $tmp =~ s/\s*#C#\s*/ <img src="..\/img\/crovoc.png" border="0">/gis;
                $tmp =~ s/"img\/crovoc.png"/"..\/img\/crovoc.png"/gis;
                return $tmp;
        }
};

## remove accented characters
#
sub unac {
        my $string = shift || return;
        $string = unac_string($code_page,$string);
        $string =~ tr/ðÐ/dD/;
        $string = unac_entities($string);
        return $string;
}
sub unac_2 {
        my $string = shift || return;
        if (length($string) > 2) {
                my $pr = substr($string,0,2);
                $string = unac_string($code_page,substr($string,2));
                $string =~ tr/ðÐ/dD/;
                $string = $pr . $string;
        }
        $string = unac_entities($string);
        return lc($string);
}

sub unac_entities {
        my $ent = shift || return;

        $ent =~ s/&(\w)(acute|cedil|circ|grave|ring|slash|tilde|uml);/$1/gi;
        $ent =~ s/&eth;/d/g;
        $ent =~ s/&E[tT][hH];/D/g;
        $ent =~ s/&(\w\w)lig;/$1/gi;

        return $ent;
}

# create WebPAC object
#
my $webpac = new WebPAC(
        code_page => $code_page,
        limit_mfn => $limit_mfn,
        start_mfn => $start_mfn,
        debug => $debug,
        low_mem => $low_mem,
        filter => $filter,
) || die;

my $log = $webpac->_get_logger() || die "can't get logger";

$log->debug("creating WebPAC::jsFind object");

my $index = new WebPAC::jsFind(
        index_path => $index_path,
        keys => 62,
) || die;

my $thes;

$|=1;

my $maxmfn = $webpac->open_isis(
        filename => shift @ARGV || '/data/hidra/THS/THS',
        lookup => [
        { 'key' => 'd:v900', 'val' => 'filter{CROVOC_tree}v250^a v800' },
#       { 'eval' => '"v901^a" eq "Podruèje"', 'key' => 'pa:v561^4:v562^4:v461^1', 'val' => 'v900' },
#       { 'eval '=> '"v901^a" eq "Mikrotezaurus"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
#       { 'eval' => '"v901^a" eq "Deskriptor"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
        { 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
        { 'key' => '900_mfn:v900', 'val' => 'v000' },
        # tree structure
        { 'eval' => 'length("v251") == 2 && "v800" =~ m/EUROVOC/ || "v800" =~ m/CROVOC/ && "v251" =~ m/^(H|HD|L|Z|P)$/', 'key' => 'root:v251', 'val' => 'v900' },
        { 'eval' => '"v251"', 'key' => 'code:v900', 'val' => 'v561^4:v251' },
        { 'eval' => '"v561^4" && "v562^4"', 'key' => 'code:v900', 'val' => 'v561^4:v562^4' },
        ],
);

$log->debug("isis file ",$webpac->{'isis_filename'}," opened");

$log->info("rows: $maxmfn");

$webpac->open_import_xml(type => 'isis_hidra_ths');

if(1) { # XXX

while (my $rec = $webpac->fetch_rec) {

        my @ds = $webpac->data_structure($rec);

        if (0 && $log->is_debug) {
                $log->debug("rec = ",Dump($rec));
                $log->debug("ds = ",Dump(\@ds));
        }

        next if (! @ds);

        my $filename = $webpac->{'current_filename'} || $log->logdie("no current_filename in webpac object");

        if ($filename) {
                $webpac->output_file(
                        file => $filename,
                        template => 'html.tt',
                        data => \@ds,
                        headline => $webpac->{'headline'},
                );
        } else {
                print $webpac->output(
                        template => 'text.tt',
                        data => \@ds,
                        headline => $webpac->{'headline'},
                );
        }

        my $headline = $webpac->{'headline'};

        my $f = $filename;
        $f =~ s!out/!!;

        # save into index
        foreach my $ds (@ds) {
                next if (! $ds->{'swish'});

                # strip all non word characters from beginning or end
                # of word
                my $words = join(" ",@{$ds->{'swish'}});
                $words =~ s/^\W+//;
                $words =~ s/\W*\s+\W*/ /g;
                $words =~ s/\W+$//;

                # first try to generate headline for this entry from index
                my $h = $ds->{'index'}->[0];
                # then, from display
                $h ||= $ds->{'display'}->[0];
                # and as last resport, fallback to headline
                $h ||= $headline;

                $index->insert(
                        index_name => $ds->{'tag'},
                        #path => $f,
                        path => $webpac->mfn,
                        headline => $h,
                        words => unac($words),
                );
        }

        # save into sorted index (thesaurus)
        foreach my $ds (@ds) {
                next if (! $ds->{'index'});

                $thes->{$ds->{'tag'}} ||= new WebPAC::Index( name => $ds->{'tag'} );

                foreach my $h (@{$ds->{'index'}}) {
                        $thes->{$ds->{'tag'}}->insert(
                                sort_by => unac_2($h),
                                mfn => $webpac->mfn,
                                headline => $h,
                        );
                }
        }

#       print Dump(\@ds);

}

foreach my $t (keys %{$thes}) {

        my @e = $thes->{$t}->elements;
        if (! @e) {
                $log->logwarn("no elements in sorted index $t?");
                next;
        }

        my $file = "./out/bfilter/$t.txt";
        $log->info("saving sorted index $t to '$file' [".scalar(@e)." elements]");

        $webpac->output_file(
                file => $file,
                template => 'index.tt',
                data => \@e,
                index_name => $t,
        );
}

if (0 && $log->is_debug) {
        $log->debug("lookup hash: ",Dump($webpac->{'lookup'}));
        $log->debug("data hash: ",Dump($webpac->{'data'}));
        foreach my $t (keys %{$thes}) {
                $log->debug("thesaurus $t hash: ",Dump($thes->{$t}));
        }
}

} # XXX if(0)

#$log->debug("lookup hash: ",Dump($webpac->{'lookup'}));

$log->info("creating tree");

#
# define tree structure
#

my $l = $webpac->{'lookup'} || $log->logconfess("can't find lookup");

my @tree = ({
        # level 0
        code_arr        => sub { sort keys %{$l} },
        filter_code     => sub {
                                        my $t = shift;
                                        return $t if ($t =~ s/root://);
                                },
        lookup_v900     => sub { shift @{$l->{"root:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[1]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[1]}} },
        have_children   => sub { return $l->{"a:".$_[0]."::"} },
        have_children_at_level => sub {
                                return unless (defined($l->{"code:".$_[1]}));
                                my $code = shift @{$l->{"code:".$_[1]}};
                                print STDERR "## $_[1] -> $code\n";
                                return undef unless($code);
                                return(9, $l->{"a:$code:"} ) if (defined($l->{"a:$code:"}));
                        },
        style           => 'display: none',
        },{
        # 1
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },       # nop
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { return $l->{"a:".$_[1].":"} },
        style           => 'display: none',
        },{
        # 2
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { return $l->{"a:".$_[1].":".$_[0]} },
        #style          => 'display: none',
        },{
        # 3 u¾i pojam
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { return $l->{"a:".$_[1].":".$_[0]} },
        },{
        # 4
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { return $l->{"a:".$_[1].":".$_[0]} },
        },{
        # 5
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { return $l->{"a:".$_[1].":".$_[0]} },
        },{
        # 6
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { return $l->{"a:".$_[1].":".$_[0]} },
        },{
        # 7
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { return $l->{"a:".$_[1].":".$_[0]} },
        },{
        # 8
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
#       have_children   => sub { return $l->{"a:".$_[1].":".$_[0]} },
        have_children   => sub { 0 },
        },{
        # 9 - level which is never reached except explicitly
        code_arr        => sub { @{$_[0]} },
        filter_code     => sub { shift },
        lookup_v900     => sub { shift @{$l->{"code:".$_[0]}} },
        lookup_term     => sub { shift @{$l->{"d:".$_[0]}} },
        lookup_mfn      => sub { shift @{$l->{"900_mfn:".$_[0]}} },
        have_children   => sub { 0 },
        have_children_at_level => sub { defined($l->{"a:".$_[1].":".$_[0]}) && return (9,$l->{"a:".$_[1].":".$_[0]}) },
        },{
});

my $tree = new WebPAC::Tree(
        tree => \@tree,
);

$tree->output(
        dir => './out',
        html => 'browse.html',
        template => './output_template/tree.tt',
        js => 'tree-ids.js',
);

$tree->output(
        dir => './eurovoc',
        html => 'hijerarhija.html',
        template => './output_template/hijerarhija.tt',
        js => 'tree-ids.js',
);


$log->info("closing index");
$index->close;

$log->info("elapsed time: ",$webpac->fmt_time(time() - $webpac->{'start_t'}));
1	#!/usr/bin/perl -w
2
3	=head1 NAME
4
5	all2all.pl - basic script for all WebPAC needs
6
7	=cut
8
9	use strict;
10	use locale;
11	use YAML;
12	use Carp;
13	use Getopt::Long;
14	use Text::Unaccent 1.02;
15
16	use lib './lib';
17	use WebPAC;
18	use WebPAC::jsFind;
19	use WebPAC::Index;
20	use WebPAC::Tree;
21
22	# options which can be changed via command line
23	#
24	my $code_page = 'ISO-8859-2';
25	my ($limit_mfn, $start_mfn, $debug, $low_mem);
26	my $index_path = './out/index';
27
28	my $result = GetOptions(
29	"code_page=s" => \$code_page,
30	"limit_mfn=i" => \$limit_mfn,
31	"start_mfn=i" => \$start_mfn,
32	"debug!" => \$debug,
33	"low_mem!" => \$low_mem,
34	);
35
36	my $filter = {
37	'CROVOC' => sub {
38	my $tmp = shift \|\| return;
39	return undef unless ($tmp =~ s/\sCROVOC.$/ #C#/);
40	# remove repeating stars
41	# FIXME this should be fixed at right place, not here!
42	$tmp =~ s/(\s*#C#)+/ #C#/g;
43	return $tmp;
44	},
45	'CROVOC_tree' => sub {
46	my $tmp = shift \|\| return;
47	$tmp =~ s/\sCROVOC.$/ <img src="img\/crovoc.png" border="0">/;
48	$tmp =~ s/\sEUROVOC.//;
49	return $tmp;
50	},
51	# TT filter
52	'CROVOC_img' => sub {
53	my $tmp = shift;
54	$tmp =~ s/\s#C#\s/ <img src="..\/img\/crovoc.png" border="0">/gis;
55	$tmp =~ s/"img\/crovoc.png"/"..\/img\/crovoc.png"/gis;
56	return $tmp;
57	}
58	};
59
60	## remove accented characters
61	#
62	sub unac {
63	my $string = shift \|\| return;
64	$string = unac_string($code_page,$string);
65	$string =~ tr/ðÐ/dD/;
66	$string = unac_entities($string);
67	return $string;
68	}
69	sub unac_2 {
70	my $string = shift \|\| return;
71	if (length($string) > 2) {
72	my $pr = substr($string,0,2);
73	$string = unac_string($code_page,substr($string,2));
74	$string =~ tr/ðÐ/dD/;
75	$string = $pr . $string;
76	}
77	$string = unac_entities($string);
78	return lc($string);
79	}
80
81	sub unac_entities {
82	my $ent = shift \|\| return;
83
84	$ent =~ s/&(\w)(acute\|cedil\|circ\|grave\|ring\|slash\|tilde\|uml);/$1/gi;
85	$ent =~ s/ð/d/g;
86	$ent =~ s/&E[tT][hH];/D/g;
87	$ent =~ s/&(\w\w)lig;/$1/gi;
88
89	return $ent;
90	}
91
92	# create WebPAC object
93	#
94	my $webpac = new WebPAC(
95	code_page => $code_page,
96	limit_mfn => $limit_mfn,
97	start_mfn => $start_mfn,
98	debug => $debug,
99	low_mem => $low_mem,
100	filter => $filter,
101	) \|\| die;
102
103	my $log = $webpac->_get_logger() \|\| die "can't get logger";
104
105	$log->debug("creating WebPAC::jsFind object");
106
107	my $index = new WebPAC::jsFind(
108	index_path => $index_path,
109	keys => 62,
110	) \|\| die;
111
112	my $thes;
113
114	$\|=1;
115
116	my $maxmfn = $webpac->open_isis(
117	filename => shift @ARGV \|\| '/data/hidra/THS/THS',
118	lookup => [
119	{ 'key' => 'd:v900', 'val' => 'filter{CROVOC_tree}v250^a v800' },
120	# { 'eval' => '"v901^a" eq "Podruèje"', 'key' => 'pa:v561^4:v562^4:v461^1', 'val' => 'v900' },
121	# { 'eval '=> '"v901^a" eq "Mikrotezaurus"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
122	# { 'eval' => '"v901^a" eq "Deskriptor"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
123	{ 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
124	{ 'key' => '900_mfn:v900', 'val' => 'v000' },
125	# tree structure
126	{ 'eval' => 'length("v251") == 2 && "v800" =~ m/EUROVOC/ \|\| "v800" =~ m/CROVOC/ && "v251" =~ m/^(H\|HD\|L\|Z\|P)$/', 'key' => 'root:v251', 'val' => 'v900' },
127	{ 'eval' => '"v251"', 'key' => 'code:v900', 'val' => 'v561^4:v251' },
128	{ 'eval' => '"v561^4" && "v562^4"', 'key' => 'code:v900', 'val' => 'v561^4:v562^4' },
129	],
130	);
131
132	$log->debug("isis file ",$webpac->{'isis_filename'}," opened");
133
134	$log->info("rows: $maxmfn");
135
136	$webpac->open_import_xml(type => 'isis_hidra_ths');
137
138	if(1) { # XXX
139
140	while (my $rec = $webpac->fetch_rec) {
141
142	my @ds = $webpac->data_structure($rec);
143
144	if (0 && $log->is_debug) {
145	$log->debug("rec = ",Dump($rec));
146	$log->debug("ds = ",Dump(\@ds));
147	}
148
149	next if (! @ds);
150
151	my $filename = $webpac->{'current_filename'} \|\| $log->logdie("no current_filename in webpac object");
152
153	if ($filename) {
154	$webpac->output_file(
155	file => $filename,
156	template => 'html.tt',
157	data => \@ds,
158	headline => $webpac->{'headline'},
159	);
160	} else {
161	print $webpac->output(
162	template => 'text.tt',
163	data => \@ds,
164	headline => $webpac->{'headline'},
165	);
166	}
167
168	my $headline = $webpac->{'headline'};
169
170	my $f = $filename;
171	$f =~ s!out/!!;
172
173	# save into index
174	foreach my $ds (@ds) {
175	next if (! $ds->{'swish'});
176
177	# strip all non word characters from beginning or end
178	# of word
179	my $words = join(" ",@{$ds->{'swish'}});
180	$words =~ s/^\W+//;
181	$words =~ s/\W\s+\W/ /g;
182	$words =~ s/\W+$//;
183
184	# first try to generate headline for this entry from index
185	my $h = $ds->{'index'}->[0];
186	# then, from display
187	$h \|\|= $ds->{'display'}->[0];
188	# and as last resport, fallback to headline
189	$h \|\|= $headline;
190
191	$index->insert(
192	index_name => $ds->{'tag'},
193	#path => $f,
194	path => $webpac->mfn,
195	headline => $h,
196	words => unac($words),
197	);
198	}
199
200	# save into sorted index (thesaurus)
201	foreach my $ds (@ds) {
202	next if (! $ds->{'index'});
203
204	$thes->{$ds->{'tag'}} \|\|= new WebPAC::Index( name => $ds->{'tag'} );
205
206	foreach my $h (@{$ds->{'index'}}) {
207	$thes->{$ds->{'tag'}}->insert(
208	sort_by => unac_2($h),
209	mfn => $webpac->mfn,
210	headline => $h,
211	);
212	}
213	}
214
215	# print Dump(\@ds);
216
217	}
218
219	foreach my $t (keys %{$thes}) {
220
221	my @e = $thes->{$t}->elements;
222	if (! @e) {
223	$log->logwarn("no elements in sorted index $t?");
224	next;
225	}
226
227	my $file = "./out/bfilter/$t.txt";
228	$log->info("saving sorted index $t to '$file' [".scalar(@e)." elements]");
229
230	$webpac->output_file(
231	file => $file,
232	template => 'index.tt',
233	data => \@e,
234	index_name => $t,
235	);
236	}
237
238	if (0 && $log->is_debug) {
239	$log->debug("lookup hash: ",Dump($webpac->{'lookup'}));
240	$log->debug("data hash: ",Dump($webpac->{'data'}));
241	foreach my $t (keys %{$thes}) {
242	$log->debug("thesaurus $t hash: ",Dump($thes->{$t}));
243	}
244	}
245
246	} # XXX if(0)
247
248	#$log->debug("lookup hash: ",Dump($webpac->{'lookup'}));
249
250	$log->info("creating tree");
251
252	#
253	# define tree structure
254	#
255
256	my $l = $webpac->{'lookup'} \|\| $log->logconfess("can't find lookup");
257
258	my @tree = ({
259	# level 0
260	code_arr => sub { sort keys %{$l} },
261	filter_code => sub {
262	my $t = shift;
263	return $t if ($t =~ s/root://);
264	},
265	lookup_v900 => sub { shift @{$l->{"root:".$_[0]}} },
266	lookup_term => sub { shift @{$l->{"d:".$_[1]}} },
267	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[1]}} },
268	have_children => sub { return $l->{"a:".$_[0]."::"} },
269	have_children_at_level => sub {
270	return unless (defined($l->{"code:".$_[1]}));
271	my $code = shift @{$l->{"code:".$_[1]}};
272	print STDERR "## $_[1] -> $code\n";
273	return undef unless($code);
274	return(9, $l->{"a:$code:"} ) if (defined($l->{"a:$code:"}));
275	},
276	style => 'display: none',
277	},{
278	# 1
279	code_arr => sub { @{$_[0]} },
280	filter_code => sub { shift }, # nop
281	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
282	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
283	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
284	have_children => sub { return $l->{"a:".$_[1].":"} },
285	style => 'display: none',
286	},{
287	# 2
288	code_arr => sub { @{$_[0]} },
289	filter_code => sub { shift },
290	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
291	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
292	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
293	have_children => sub { return $l->{"a:".$_[1].":".$_[0]} },
294	#style => 'display: none',
295	},{
296	# 3 u¾i pojam
297	code_arr => sub { @{$_[0]} },
298	filter_code => sub { shift },
299	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
300	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
301	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
302	have_children => sub { return $l->{"a:".$_[1].":".$_[0]} },
303	},{
304	# 4
305	code_arr => sub { @{$_[0]} },
306	filter_code => sub { shift },
307	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
308	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
309	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
310	have_children => sub { return $l->{"a:".$_[1].":".$_[0]} },
311	},{
312	# 5
313	code_arr => sub { @{$_[0]} },
314	filter_code => sub { shift },
315	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
316	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
317	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
318	have_children => sub { return $l->{"a:".$_[1].":".$_[0]} },
319	},{
320	# 6
321	code_arr => sub { @{$_[0]} },
322	filter_code => sub { shift },
323	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
324	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
325	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
326	have_children => sub { return $l->{"a:".$_[1].":".$_[0]} },
327	},{
328	# 7
329	code_arr => sub { @{$_[0]} },
330	filter_code => sub { shift },
331	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
332	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
333	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
334	have_children => sub { return $l->{"a:".$_[1].":".$_[0]} },
335	},{
336	# 8
337	code_arr => sub { @{$_[0]} },
338	filter_code => sub { shift },
339	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
340	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
341	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
342	# have_children => sub { return $l->{"a:".$_[1].":".$_[0]} },
343	have_children => sub { 0 },
344	},{
345	# 9 - level which is never reached except explicitly
346	code_arr => sub { @{$_[0]} },
347	filter_code => sub { shift },
348	lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
349	lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
350	lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
351	have_children => sub { 0 },
352	have_children_at_level => sub { defined($l->{"a:".$_[1].":".$_[0]}) && return (9,$l->{"a:".$_[1].":".$_[0]}) },
353	},{
354	});
355
356	my $tree = new WebPAC::Tree(
357	tree => \@tree,
358	);
359
360	$tree->output(
361	dir => './out',
362	html => 'browse.html',
363	template => './output_template/tree.tt',
364	js => 'tree-ids.js',
365	);
366
367	$tree->output(
368	dir => './eurovoc',
369	html => 'hijerarhija.html',
370	template => './output_template/hijerarhija.tt',
371	js => 'tree-ids.js',
372	);
373
374
375	$log->info("closing index");
376	$index->close;
377
378	$log->info("elapsed time: ",$webpac->fmt_time(time() - $webpac->{'start_t'}));