#!/usr/bin/perl -s
our ($dir,$nostyle);
$dir ||= ".";
my $thesaurus= shift or die("Usage: $0 [-dir=...] thesaurus [lang*]\n");
mkdir($dir) unless -d $dir;
my $obj;
use Biblio::Thesaurus;
use CGI qw(:all :nodebug);
for my $lang ("",@ARGV)
{
if($lang){ system("thesaurusTranslate $thesaurus - $lang > _$thesaurus$lang");
$thename="_$thesaurus$lang";}
else { $thename=$thesaurus; }
my $la="!";
$obj = thesaurusLoad($thename);
open (G,">$dir/${lang}0_lista_de_termos.html") or die("cant create index");
binmode(G,":utf8");
binmode(STDERR,":utf8");
$obj->baselang('_') if ($obj->{baselang} eq "?");
print G $obj->downtr(
{-default => sub {
my $cla=(exists $obj->{languages}{$rel})?"lingua":"rel";
if (@terms > 1) {
li({-class => $cla},
strong($obj->getDescription($rel)),"\t".
ul(li([map{ a({href=>t2f($_,$cla,$rel)},$_)."\n"} sort @terms])))."\n";
}
else {
li({-class => $cla, '-lang' => $rel},
strong($obj->getDescription($rel)),"\t".
join(", ", map{ a({href=>t2f($_,$cla,$rel)},$_)."\n"} sort @terms))."\n";
}
},
-order => ["IOF",
"PT","EN","FR",'SP','ES',"DE","IT","DA","NL","SV","FI" ,"EL","HU","HE"
,"BT","NT","RT","MT","UF","USE","SN"],
-end => sub { ambsheader($obj->{title},$obj->{baselang}).
($obj->{title}? h2($obj->{title}):"").
($obj->{author}? h3($obj->{author}):"").
"\n\n $_ \n
\n".
ambsfooter();
},
-eachTerm => sub {
mkdir("$dir/" . uc($obj->{baselang})) unless -d ("$dir/" . uc($obj->{baselang}));
my $tt=t2f($term,"lingua",$obj->{baselang},1);
open(F,">$dir/$tt") or die ("cant create file $dir/$tt\n");
binmode(F,":utf8");
print F ambsheader($term,$obj->{baselang});
print F h3($term).ul($_)."\n";
print F ambsfooter();
close F;
print STDERR "$term\n";
if(lett($term) ne $la){ $la = lett($term);
return "\n".li(a({href=>$tt},red($term)));}
else{ return "\n".li(a({href=>$tt},$term));}
},
SN => sub{ li({-class=>"text"},strong("sn"),join("",@terms)) },
});
close G;
}
sub t2f{
my ($a,$c,$r,$f)=@_;
my $dir= uc( ($c eq "lingua")? $r : $obj->{baselang});
for ($a){
s/[Ίͺ\[\] \(\)\/\?\":]/_/g ;
tr [A-ZΑΙΝΣΪΒΚΤΗΓΥΡΔΛΟΦά]
[a-zαινσϊβκτηγυρδλοφό] ;
s/([\x{80}-\x{ffff}])/sprintf('=%x',ord($1))/ge ;
# tr [A-ZΑΙΝΣΪΒΚΤΗΓΥΡΔΛΟΦά]
# [a-zaeiouaeocaonaeiou] ;
# tr/αινσϊΰθμςωβκξτϋδλοφόγυρη/AEIOUAEIOUAEIOUAEIOUAONC/;
}
($f)?"$dir/$a.html":"../$dir/$a.html"
}
sub lett{
my $p=shift;
$p =~ s/\W//g ;
$p =~ tr [A-ZΑΙΝΣΪΒΚΤΗΓΥΡΔΛΟΦά]
[a-zaeiouaeocaonaeiou] ;
$p =~ tr [αινσϊβκτηγυρδλοφό]
[aeiouaeocaonaeiou] ;
substr $p,0,1;
}
sub ambsheader{
my ($t,$l)=@_;
return qq{
$t
} .
($nostyle
?""
: qq{\n}).
qq{
};
}
sub ambsfooter{
return qq{
}
}
sub red{ font({color=>"red"},@_)}
__END__
NumExp
__END__
=head1 NAME
thesaurus2htmls - generates a HTML site (one file for each term)
=head1 SYNOPSIS
thesaurus2htmls [-dir=D] thesaurus [lang*]
=head1 DESCRIPTION
For each term in each language passed as argument, creates a linked
HTML page.
=head1 AUTHOR
J.Joao Almeida, jj@di.uminho.pt
=head1 SEE ALSO
perl(1).
=cut