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;
                $tmp =~ s/\s*HIDRA.*//;
                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.*//;
                $tmp =~ s/\s*HIDRA.*//;
                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' },
        { 'key' => 'crovoc:v900', 'val' => 'filter{CROVOC}v800' },
        ],
);

$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 = unac(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 => $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',
        iframe          => 1,
        },{
        # 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,
        detail_url => sub {
                my $mfn = shift;
                my $url = "thes/${mfn}.html";
                return $url if (-e "./out/$url");
        },
        nodes_dir => 'nodes',
);

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

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


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

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