--- trunk2/all2all.pl 2004/10/09 21:44:25 490 +++ trunk2/all2all.pl 2004/11/01 15:29:17 573 @@ -11,6 +11,7 @@ use YAML; use Carp; use Getopt::Long; +use Text::Unaccent 1.02; use lib './lib'; use WebPAC; @@ -32,6 +33,64 @@ "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.*$/ /; + $tmp =~ s/\s*EUROVOC.*//; + $tmp =~ s/\s*HIDRA.*//; + return $tmp; + }, + # TT filter + 'CROVOC_img' => sub { + my $tmp = shift; + $tmp =~ s/\s*#C#\s*/ /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/ð/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( @@ -40,6 +99,7 @@ start_mfn => $start_mfn, debug => $debug, low_mem => $low_mem, + filter => $filter, ) || die; my $log = $webpac->_get_logger() || die "can't get logger"; @@ -48,7 +108,7 @@ my $index = new WebPAC::jsFind( index_path => $index_path, - keys => 10, + keys => 62, ) || die; my $thes; @@ -58,7 +118,7 @@ my $maxmfn = $webpac->open_isis( filename => shift @ARGV || '/data/hidra/THS/THS', lookup => [ - { 'key' => 'd:v900', 'val' => 'v250^a' }, + { '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' }, @@ -123,12 +183,19 @@ $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 => $headline, - words => $words, + headline => $h, + words => unac($words), ); } @@ -136,12 +203,13 @@ foreach my $ds (@ds) { next if (! $ds->{'index'}); - $thes->{$ds->{'tag'}} ||= new WebPAC::Index; + $thes->{$ds->{'tag'}} ||= new WebPAC::Index( name => $ds->{'tag'} ); foreach my $h (@{$ds->{'index'}}) { $thes->{$ds->{'tag'}}->insert( - headline => $h, + sort_by => unac_2($h), mfn => $webpac->mfn, + headline => $h, ); } } @@ -179,7 +247,7 @@ } # XXX if(0) -$log->debug("lookup hash: ",Dump($webpac->{'lookup'})); +#$log->debug("lookup hash: ",Dump($webpac->{'lookup'})); $log->info("creating tree"); @@ -217,6 +285,7 @@ lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, have_children => sub { return $l->{"a:".$_[1].":"} }, style => 'display: none', + iframe => 1, },{ # 2 code_arr => sub { @{$_[0]} }, @@ -225,7 +294,7 @@ 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', + style => 'display: none', },{ # 3 u¾i pojam code_arr => sub { @{$_[0]} }, @@ -288,13 +357,35 @@ }); my $tree = new WebPAC::Tree( - dir => './out', - html => 'browse.html', - template => './output_template/tree.tt', - js => 'tree-ids.js', tree => \@tree, + detail_url => sub { + my $mfn = shift; + my $url = "./out/thes/${mfn}.html"; + return $url if (-e $url); + }, ); +$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', +); + +$tree->output( + dir => './eurovoc', + html => 'hijerarhija.html', + template_dir => './output_template/', + template_tree => 'hijerarhija.tt', + template_node => 'hijerarhija_node.tt', + nodes => 'nodes', + js => 'tree-ids.js', +); + + $log->info("closing index"); $index->close;