Subversion Repositories wimsdev

Rev

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

  1. #!/usr/bin/perl
  2.  
  3. use warnings;
  4. use strict;
  5. my %ref;
  6. my $ref=\%ref;
  7. my %strong;
  8. my $strong=\%strong;
  9. my ($type, $add)=("","");
  10. my $glist="";
  11. my @list_sort=();
  12. my $list_to_sort="";
  13. for my $file (glob("*/*/*/*")) {
  14.   open(IN, $file) ;
  15.   $glist .= "$file\n" if !($file=~/_\d\b/) && !($file=~/\/macro\//);
  16.   while (<IN>) { my $line = $_;
  17.     if ($line=~ /<strong>([^<]+)<\/strong>/) { $strong{$1} .= " $file"};
  18.     next if !($line =~ /gl_keywords=/ || $line =~ /gl_type=/) ;
  19.     $type=$1 if($line=~/gl_type=(.*)/);
  20.     $add =$1 if($line=~/!set gl_keywords=(.*)/);
  21.     chomp $add; chomp $type;
  22.     @list_sort=split('/', $file);
  23.     $list_to_sort .= "$list_sort[0],$list_sort[1],$list_sort[3],$list_sort[2]\n";
  24.   }
  25.   $type='main' if !($type);
  26.   $ref{$add} .= "$file/$type " if ($add);
  27.   $type=""; $add="";
  28. };
  29.  
  30. @list_sort=sortuniq(split("\n",join("\n", sortuniq(split("\n",$list_to_sort)))));
  31.  
  32. for my $line (@list_sort){
  33.   if($line) {
  34.     my @l=split(',', $line);
  35.     $glist .= "$l[0]/$l[1]/$l[3]/$l[2]\n";
  36.   }
  37. }
  38.  
  39. my $Text="generated by mkindex.pl\n\n";
  40. while (my ($key, $value) = each(%ref) ) {
  41.   my $s= join(",",sortuniq(split(' ', $value)));
  42.   $Text .= $key . ":" . $s . "\n" ;
  43. }
  44. out("connexe_domain",$Text);
  45.  
  46. $Text="";
  47. while (my ($key, $value) = each(%strong) ) {
  48.   my $s= join(",",sortuniq(split(' ', $value)));
  49.   $Text .= $key . ":" . $s . "\n" ;
  50. }
  51. out("strong_index",join("\n",sortuniq(split("\n",$Text))));
  52. out("glist",$glist);
  53.  
  54. sub sortuniq {
  55.   my $prev = "not $_[0]";
  56.   grep { $_ ne $prev && ($prev = $_, 1) } sort @_;
  57. }
  58.  
  59. sub out { my ($bloc, $text) = @_;
  60.   open  (OUT, ">$bloc") ;
  61.   print OUT $text ; close OUT;
  62. }
  63.