Subversion Repositories wimsdev

Rev

Rev 11479 | Rev 16932 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. #!/usr/bin/perl
  2.  
  3. # From the distribution files
  4. # domain : structured list of all (sub)domains (words containing underscores)
  5. # domain.xx : list of correspondance between domain names and their translation (spaces allowed) in language xx.
  6. # this script constructs the following files
  7. # reversedomain  : list of parents of each domain
  8. # domain.json    : list of domains up to third level
  9. # domain.xx.json : sorted list of translations of domain names (without domain_name itself)
  10. # domain.xx.tmp  : should be (not checked) domains of file domain for which a translation exists in domain.xx.
  11. ##                 In practice it is (not checked) same as domain.xx,
  12. ##                 with empty translation replaced by left member (= domain_name) of record
  13. ##                 and completed with domains appearing in domain but not in domain.xx.
  14. ##                 This is also sorted.
  15. # domaindic.xx.tmp   : dictionnary for modind
  16. use warnings;
  17. use strict;
  18. use search ('hashdomain', 'listdomain', 'out', 'sortuniq', 'treate_dict', 'treate_language','treate_accent');
  19.  
  20. my $dir='domain';
  21. my $outputkeywords='tmp';
  22. my @site_lang= treate_language ();
  23. $/ = undef;
  24.  
  25. ## Make sorted list of all domains in domain/domain
  26. my @list=listdomain("$dir/domain");
  27.  
  28. ## For translators : make a domain.template as a base for domain.xx file
  29. ## Helpful for creation of new language or to check for completeness of current domain.xx file
  30. #my $text=join(":\n", @list) . ":\n";
  31. #$text=~ s/^://g;
  32. #$text=~ s/ +\n/\n/g;
  33. #out("$dir/domain.template", $text);
  34.  
  35. ## Put in domain/reversedomain the list of parents of each domain.
  36. my %ref= hashdomain("$dir/domain");
  37. my $ref=\%ref;
  38. my $TEXT="##generated by mkdomain.pl\n";
  39. for my $tag (sort keys %{$ref->{'prev'}}) {
  40.   $TEXT .= $tag . ":" . $ref->{'prev'}{$tag} . "\n" ;
  41. }
  42.  
  43. out("$dir/reversedomain",$TEXT);
  44.  
  45. ## Put in domain/domain.json the sorted list of domains up to third level
  46. out("$dir/domain.json", domainjson());
  47. out("$outputkeywords/keywords.tech.json", keywordsjson(%ref));
  48.  
  49. ## for languages for which domain.xx exists, construct files
  50. ## domain.xx.tmp : sorted list of domains names and their translation, approximately union of domain and domain.xx
  51. ## domain.xx.json : sorted list of translations of domain names (without domain_name itself)
  52. for my $la ( @site_lang) {
  53.  next if !(-e "$dir/domain.$la");
  54.  my %dom = treate_dict ("$dir/domain.$la");
  55.  my $dom = \%dom;
  56.   for my $a (@list) {
  57.   if (!$dom{$a}) { $dom{$a} = '' ; }
  58.  };
  59.  my @D=();
  60.  my @D_lang=();
  61.  my @D_reverse=();
  62.  while ( my ($key, $value) = each(%dom) ) {
  63.    push @D, "$key:$value";
  64.    $key=~ s/_/ /g;
  65.    if ($value) {
  66.      ##push @D_reverse, lc(treate_accent($value)) . ":$key|" . lc(treate_accent($value));
  67.      for my $v (split(',', lc(treate_accent($value)))) {
  68.        push @D_reverse,  $v . ":$key";
  69.      }
  70.    }
  71.    $value=~ s/'/ /g;
  72.    push @D_lang, split(',',lc($value));
  73.  };
  74.  out("$dir/domain.$la.tmp", join("\n",sortuniq(@D)) . "\n");
  75.  out("$dir/domaindic.$la.tmp", join("\n",sortuniq(@D_reverse)) . "\n");
  76.  out("$dir/domain.$la.json", "\"" . join("\",\n\"",sortuniq(@D_lang)) . "\"");
  77. }
  78.  
  79. #####################################################
  80. sub domainjson {
  81.   my @D=();
  82.   my %dom = treate_dict ("$dir/domain.en");
  83.   my $dom = \%dom;
  84.   while ( my ($key, $value) = each(%dom) ) {
  85.    if (defined $ref->{'prev'}{$key} && $ref->{'prev'}{$key}=~/domain\b/) {
  86.     if (!($key =~ /zdomain\b/)) {push @D, $key };
  87.     if (defined $ref->{'next'}{$key}) { push @D, split(',', $ref->{'next'}{$key})};
  88.    };
  89.  }
  90. "<!-- generated by mkdomain.pl-->\n['" . join("',\n'", sortuniq(@D)) . "']";
  91. }
  92.  
  93. sub keywordsjson { my ($ref) = @_ ;
  94. "[\"" . join("\",\n\"", sortuniq(keys %ref)) . "\"]";
  95. }
  96.