Subversion Repositories wimsdev

Rev

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