--- trunk2/all2all.pl 2004/09/14 17:07:59 441 +++ trunk2/all2all.pl 2004/11/01 18:00:26 575 @@ -7,9 +7,11 @@ =cut use strict; -use Data::Dumper; +use locale; +use YAML; use Carp; use Getopt::Long; +use Text::Unaccent 1.02; use lib './lib'; use WebPAC; @@ -31,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( @@ -39,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"; @@ -47,7 +108,7 @@ my $index = new WebPAC::jsFind( index_path => $index_path, - keys => 10, + keys => 62, ) || die; my $thes; @@ -57,15 +118,16 @@ 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' }, { 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' }, { 'key' => '900_mfn:v900', 'val' => 'v000' }, # tree structure - { 'eval' => 'length("v251") == 2', 'key' => 'root:v251', 'val' => 'v900' }, + { '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' }, ], ); @@ -82,8 +144,8 @@ my @ds = $webpac->data_structure($rec); if (0 && $log->is_debug) { - $log->debug("rec = ",Dumper($rec)); - $log->debug("ds = ",Dumper(\@ds)); + $log->debug("rec = ",Dump($rec)); + $log->debug("ds = ",Dump(\@ds)); } next if (! @ds); @@ -114,11 +176,26 @@ 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, - headline => $headline, - words => join(" ",@{$ds->{'swish'}}) + #path => $f, + path => $webpac->mfn, + headline => $h, + words => unac($words), ); } @@ -126,17 +203,18 @@ 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( - path => $f, + sort_by => unac_2($h), + mfn => $webpac->mfn, headline => $h, ); } } -# print Dumper(\@ds); +# print Dump(\@ds); } @@ -160,16 +238,16 @@ } if (0 && $log->is_debug) { - $log->debug("lookup hash: ",Dumper($webpac->{'lookup'})); - $log->debug("data hash: ",Dumper($webpac->{'data'})); + $log->debug("lookup hash: ",Dump($webpac->{'lookup'})); + $log->debug("data hash: ",Dump($webpac->{'data'})); foreach my $t (keys %{$thes}) { - $log->debug("thesaurus $t hash: ",Dumper($thes->{$t})); + $log->debug("thesaurus $t hash: ",Dump($thes->{$t})); } } } # XXX if(0) -$log->debug("lookup hash: ",Dumper($webpac->{'lookup'})); +#$log->debug("lookup hash: ",Dump($webpac->{'lookup'})); $log->info("creating tree"); @@ -189,119 +267,124 @@ 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 { defined($l->{"a:".$_[0]."::"}) }, - child_code => sub { return $_[0] }, + 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 { @{$l->{"a:".$_[0]."::"}} }, + 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 { defined($l->{"a:".$_[1].":"}) }, - child_code => sub { return $_[1] }, + have_children => sub { return $l->{"a:".$_[1].":"} }, style => 'display: none', + iframe => 1, },{ # 2 - code_arr => sub { @{$l->{"a:".$_[0].":"}} }, + code_arr => sub { @{$_[0]} }, filter_code => sub { shift }, - lookup_v900 => 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 { defined($l->{"a:".$_[2].":".$_[1]}) }, - child_code => sub { return "a:".$_[2].":".$_[1] }, + have_children => sub { return $l->{"a:".$_[1].":".$_[0]} }, style => 'display: none', },{ # 3 u¾i pojam - code_arr => sub { @{$l->{$_[0]}} }, + code_arr => sub { @{$_[0]} }, filter_code => sub { shift }, - lookup_v900 => sub { - my ($c,$p) = @_; - $p =~ s/^a:(..:....):.*$/$1/; - return "a:".$p.":".$c; - }, + 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 { defined($l->{$_[1]}) }, - child_code => sub { return $_[1] }, + have_children => sub { return $l->{"a:".$_[1].":".$_[0]} }, },{ # 4 - code_arr => sub { @{$l->{$_[0]}} }, + code_arr => sub { @{$_[0]} }, filter_code => sub { shift }, - lookup_v900 => sub { - my ($c,$p) = @_; - $p =~ s/^a:(..:....):.*$/$1/; - return "a:".$p.":".$c; - }, + 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 { defined($l->{$_[1]}) }, - child_code => sub { return $_[1] }, + have_children => sub { return $l->{"a:".$_[1].":".$_[0]} }, },{ # 5 - code_arr => sub { @{$l->{$_[0]}} }, + code_arr => sub { @{$_[0]} }, filter_code => sub { shift }, - lookup_v900 => sub { - my ($c,$p) = @_; - $p =~ s/^a:(..:....):.*$/$1/; - return "a:".$p.":".$c; - }, + 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 { defined($l->{$_[1]}) }, - child_code => sub { return $_[1] }, + have_children => sub { return $l->{"a:".$_[1].":".$_[0]} }, },{ # 6 - code_arr => sub { @{$l->{$_[0]}} }, + code_arr => sub { @{$_[0]} }, filter_code => sub { shift }, - lookup_v900 => sub { - my ($c,$p) = @_; - $p =~ s/^a:(..:....):.*$/$1/; - return "a:".$p.":".$c; - }, + 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 { defined($l->{$_[1]}) }, - child_code => sub { return $_[1] }, + have_children => sub { return $l->{"a:".$_[1].":".$_[0]} }, },{ # 7 - code_arr => sub { @{$l->{$_[0]}} }, + code_arr => sub { @{$_[0]} }, filter_code => sub { shift }, - lookup_v900 => sub { - my ($c,$p) = @_; - $p =~ s/^a:(..:....):.*$/$1/; - return "a:".$p.":".$c; - }, + 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 { defined($l->{$_[1]}) }, - child_code => sub { return $_[1] }, + have_children => sub { return $l->{"a:".$_[1].":".$_[0]} }, },{ # 8 - code_arr => sub { @{$l->{$_[0]}} }, + code_arr => sub { @{$_[0]} }, filter_code => sub { shift }, - lookup_v900 => sub { - my ($c,$p) = @_; - $p =~ s/^a:(..:....):.*$/$1/; - return "a:".$p.":".$c; - }, + 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 { defined($l->{$_[1]}) }, -# child_code => sub { return $_[1] }, have_children => sub { 0 }, - child_code => sub { 0 }, + have_children_at_level => sub { defined($l->{"a:".$_[1].":".$_[0]}) && return (9,$l->{"a:".$_[1].":".$_[0]}) }, + },{ }); 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 = "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;