Subversion Repositories wimsdev

Rev

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

  1. package search;
  2.  
  3. use strict;
  4. use warnings;
  5. use Encode;
  6.  
  7. use Exporter;
  8. our @ISA = 'Exporter';
  9. our @EXPORT = ('hashdomain', 'listdomain', 'out','sortuniq', 'treate_accent','treate_dict', 'treate_language');
  10.  
  11. sub treate_dict { my ($file) = @_;
  12.    my %ref = ( ) ; my $ref=\%ref; my $text;
  13.    open IN, "$file";
  14.    while (<IN>) {
  15.    $text = $_ ;
  16.    $text =~ s/\n +/\n/g;
  17.    $text =~ s/\\//g;
  18.    $text =~ s/^(\s+)//g;
  19.    $text=~ s/\n+/\n/g;
  20.    my @L = sortuniq(split("\n",$text));
  21.    for my $l (@L) {
  22.      my @la=split(":", $l) ;
  23.      $ref{$la[0]}=$la[1] if ($la[1]);
  24.     }
  25.    }
  26.   close IN;
  27.  %ref;
  28. }
  29.  
  30. sub treate_accent {my ($txt) = @_;
  31.   $txt=decode('iso-8859-1',$txt);
  32.   $txt =~ tr/éèêëàáâãäåùìíîïóôòç/eeeeaaaaaauiiiioooc/;
  33.   $txt =~ s/[ÀÁÂÃÄÅ]/A/g;
  34.   $txt =~ s/Ç/C/g;
  35.   $txt =~ s/[ÈÉÊË]/E/g;
  36.   $txt =~ s/[ÌÏÎÍ]/I/g;
  37.   $txt= encode("iso-8859-1",$txt);
  38.   $txt
  39. }
  40.  
  41. sub out { my ($bloc, $text) = @_;
  42.   open  (OUT, ">$bloc") ;
  43.   print OUT $text ; close OUT;
  44. }
  45.  
  46. sub sortuniq {
  47.   return if !(@_) ;
  48.   my $prev = "not $_[0]";
  49.   grep { $_ ne $prev && ($prev = $_, 1) } sort @_;
  50. }
  51.  
  52. sub listdomain { my ($file)=@_ ;
  53.   my $text='';
  54.   open IN, "$file";
  55.   while (<IN>) { $text = $_ ;
  56.    $text =~ s/[,:]/\n/g;
  57.    $text =~ s/\n +/\n/g;
  58.    $text =~ s/\\//g;
  59.    $text =~ s/^(\s+)//g;
  60.    $text=~ s/\n+/\n/g;
  61.  }
  62.  close IN;
  63.  sortuniq(split("\n",$text))
  64. }
  65.  
  66. ## reversing the domain tree
  67.  
  68. sub hashdomain { my ($file)=@_;
  69.  open IN, "$file";
  70.  my %ref = ( ) ; my $ref=\%ref;
  71.  while (<IN>) { my $text=$_ ; $text=~ s/\\\n\s*//g;
  72.    $text=~ s/\n\s+/\n/g;
  73.    my @text= split("\n", $text);
  74.    for my $line (@text) {
  75.      next if !($line) ;
  76.      $line =~ s/\s+//g;
  77.      my @cut=split(":", $line) ;
  78.      if ($cut[1]) {
  79.        my @son=split(',',$cut[1]);
  80.       for my $s (@son) {
  81.         if ($ref{$s}) { $ref{$s} .= "," . $cut[0]} else {$ref{$s} = $cut[0]}
  82.       }
  83.      }
  84.    }
  85. }
  86. close IN;
  87.   %ref
  88. }
  89.  
  90. sub treate_language {
  91.   my $site_language='en fr nl it cn';
  92.   my $conf='../../../log/wims.conf';
  93.   if (-e "$conf") {
  94.    open IN, "$conf";
  95.    while (<IN>) {
  96.      if ($_ =~ s/site_languages=//) { $site_language= $_ ; }
  97.    }
  98.   close IN;
  99.  }
  100. split(' ', $site_language) ;
  101. }
  102.