Subversion Repositories wimsdev

Rev

Rev 16932 | 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 lib '/var/lib/wims/public_html/bases/sys';
  19. use lib ".";
  20. use search ('hashdomain', 'listdomain', 'out', 'sortuniq', 'treate_dict', 'treate_language','treate_accent');
  21. my $dir='domain';
  22. my $outputkeywords='tmp';
  23. my @site_lang= treate_language ();
  24. $/ = undef;
  25.  
  26. ## Make sorted list of all domains in domain/domain
  27. my @list=listdomain("$dir/domain");
  28.  
  29. ## For translators : make a domain.template as a base for domain.xx file
  30. ## Helpful for creation of new language or to check for completeness of current domain.xx file
  31. #my $text=join(":\n", @list) . ":\n";
  32. #$text=~ s/^://g;
  33. #$text=~ s/ +\n/\n/g;
  34. #out("$dir/domain.template", $text);
  35.  
  36. ## Put in domain/reversedomain the list of parents of each domain.
  37. my %ref= hashdomain("$dir/domain");
  38. my $ref=\%ref;
  39. my $TEXT="##generated by mkdomain.pl\n";
  40. for my $tag (sort keys %{$ref->{'prev'}}) {
  41.   $TEXT .= $tag . ":" . $ref->{'prev'}{$tag} . "\n" ;
  42. }
  43.  
  44. out("$dir/reversedomain",$TEXT);
  45.  
  46. ## Put in domain/domain.json the sorted list of domains up to third level
  47. out("$dir/domain.json", domainjson());
  48. out("$outputkeywords/keywords.tech.json", keywordsjson(%ref));
  49.  
  50. ## for languages for which domain.xx exists, construct files
  51. ## domain.xx.tmp : sorted list of domains names and their translation, approximately union of domain and domain.xx
  52. ## domain.xx.json : sorted list of translations of domain names (without domain_name itself)
  53. for my $la ( @site_lang) {
  54.  next if !(-e "$dir/domain.$la");
  55.  my %dom = treate_dict ("$dir/domain.$la");
  56.  my $dom = \%dom;
  57.   for my $a (@list) {
  58.   if (!$dom{$a}) { $dom{$a} = '' ; }
  59.  };
  60.  my @D=();
  61.  my @D_lang=();
  62.  my @D_reverse=();
  63.  while ( my ($key, $value) = each(%dom) ) {
  64.    push @D, "$key:$value";
  65.    $key=~ s/_/ /g;
  66.    if ($value) {
  67.      ##push @D_reverse, lc(treate_accent($value)) . ":$key|" . lc(treate_accent($value));
  68.      for my $v (split(',', lc(treate_accent($value)))) {
  69.        push @D_reverse,  $v . ":$key";
  70.      }
  71.    }
  72.    $value=~ s/'/ /g;
  73.    push @D_lang, split(',',lc($value));
  74.  };
  75.  out("$dir/domain.$la.tmp", join("\n",sortuniq(@D)) . "\n");
  76.  out("$dir/domaindic.$la.tmp", join("\n",sortuniq(@D_reverse)) . "\n");
  77.  out("$dir/domain.$la.json", "\"" . join("\",\n\"",sortuniq(@D_lang)) . "\"");
  78. }
  79.  
  80. #####################################################
  81. sub domainjson {
  82.   my @D=();
  83.   my %dom = treate_dict ("$dir/domain.en");
  84.   my $dom = \%dom;
  85.   while ( my ($key, $value) = each(%dom) ) {
  86.    if (defined $ref->{'prev'}{$key} && $ref->{'prev'}{$key}=~/domain\b/) {
  87.     if (!($key =~ /zdomain\b/)) {push @D, $key };
  88.     if (defined $ref->{'next'}{$key}) { push @D, split(',', $ref->{'next'}{$key})};
  89.    };
  90.  }
  91. "<!-- generated by mkdomain.pl-->\n['" . join("',\n'", sortuniq(@D)) . "']";
  92. }
  93.  
  94. sub keywordsjson { my ($ref) = @_ ;
  95. "[\"" . join("\",\n\"", sortuniq(keys %ref)) . "\"]";
  96. }
  97.