Subversion Repositories wimsdev

Rev

Rev 11275 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. #!/usr/bin/perl
  2.  
  3. use warnings;
  4. use strict;
  5. use Encode;
  6.  
  7. my $dirform="form";
  8. my $dirdic="dic";
  9. my %list=();
  10. my $list=\%list;
  11. my @Keywords=();
  12. my @Files = GetFilesList ($dirform);
  13. foreach my $File  (@Files) {
  14.         next if !($File =~ /.def\b/) ;
  15.         my @l=treate_keywords($File);
  16.         push @Keywords, @l;
  17. }
  18. @Keywords=sortuniq(@Keywords);
  19. out("$dirdic/form.json", "[\n\"" .join("\",\n\"", @Keywords) . "\"\n]");
  20.  
  21. my @text=();
  22. while ( my ($key, $value) = each (%list) ) {
  23.      push @text, "$key:$value" ; }
  24. ###il faut sorter
  25. out("$dirdic/form", join("\n",sortuniq(@text)));
  26.  
  27. sub treate_keywords { my ($file) = @_ ;
  28.    my $t=0; my $t1=0; my @keywords=();
  29.    my $file1 = $file ; $file1=~ s,$dirform/(.*)\.def,$1,;
  30.     open IN, $file;
  31.     while(<IN>) {
  32.       my $k = $_ ;
  33.       if( ($k =~ /^:/) && $t==0 && $t1==0) {
  34.         $t = 1; $k =~ s/://;
  35.         push @keywords,split(", *",treate_accent(lc($k))) ;
  36.       }
  37.       if( !($k =~ /^:/) && $t==1 && $t1==0) {
  38.         push @keywords,split(", *",treate_accent(lc($k))) ;
  39.       }
  40.       if( ($k =~ /^:/) && $t==1 ) {$t1=1}
  41.     }
  42.     for my $k (@keywords) { chomp $k;
  43.       next if !($k);
  44.       if (!$list{$k}) { $list{$k} .= $file1 ." "; } else {$list{$k} .= $file1 . " " };
  45.     }
  46.     close IN;
  47.    @keywords;
  48. }
  49.  
  50. sub treate_accent {my ($txt) = @_;
  51.   $txt=decode('iso-8859-1',$txt);
  52.   $txt =~ tr/éèêëàáâãäåùìíîïóôòç/eeeeaaaaaauiiiioooc/;
  53.   $txt =~ s/[ÀÁÂÃÄÅ]/A/g;
  54.   $txt =~ s/Ç/C/g;
  55.   $txt =~ s/[ÈÉÊË]/E/g;
  56.   $txt =~ s/[ÌÏÎÍ]/I/g;
  57.   $txt =~ s/'/ /g;
  58.   $txt= encode("iso-8859-1",$txt);
  59.   $txt
  60. }
  61.  
  62. sub out { my ($bloc, $text) = @_;
  63.   open  (OUT, ">$bloc") ;
  64.   print OUT $text ; close OUT;
  65. }
  66.  
  67. sub sortuniq {
  68.   my $prev = "not $_[0]";
  69.   grep { $_ ne $prev && ($prev = $_, 1) } sort @_;
  70. }
  71.  
  72. sub GetFilesList
  73. {
  74.   my $Path = $_[0];
  75.   my $FileFound;
  76.   my @FilesList=();
  77.  
  78.   # Lecture de la liste des fichiers
  79.   opendir (my $FhRep, $Path)
  80.           or die "Impossible d'ouvrir le repertoire $Path\n";
  81.   my @Contenu = grep { !/^\.\.?$/ } readdir($FhRep);
  82.   closedir ($FhRep);
  83.  
  84.   foreach my $FileFound (@Contenu) {
  85.     # Traitement des fichiers
  86.     if ( -f "$Path/$FileFound") {
  87.             push ( @FilesList, "$Path/$FileFound" );
  88.     }
  89.     # Traitement des repertoires
  90.     elsif ( -d "$Path/$FileFound") {
  91.             # Boucle pour lancer la recherche en mode recursif
  92.             push (@FilesList, GetFilesList("$Path/$FileFound") );
  93.     }
  94.  
  95.   }
  96.    return @FilesList;
  97. }
  98.  
  99.