Subversion Repositories wimsdev

Rev

Rev 12644 | 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. for my $file (glob("*/*/*/*")) {
  11.   open(IN, $file) ;
  12.   while (<IN>) { my $line = $_;
  13.     if ($line=~ /<strong>([^<]+)<\/strong>/) { $strong{$1} .= " $file"};
  14.     next if !($line =~ /gl_keywords=/ || $line =~ /gl_type=/) ;
  15.     $type=$1 if($line=~/gl_type=(.*)/);
  16.     $add =$1 if($line=~/!set gl_keywords=(.*)/);
  17.     chomp $add; chomp $type;
  18.   }
  19.   $type='main' if !($type);
  20.   $ref{$add} .= "$file/$type " if ($add);
  21.   $type="";$add="";
  22. };
  23. my $Text="generated by mkindex.pl\n\n";
  24. while (my ($key, $value) = each(%ref) ) {
  25.   my $s= join(",",sortuniq(split(' ', $value)));
  26.   $Text .= $key . ":" . $s . "\n" ;
  27. }
  28. out("connexe_domain",$Text);
  29.  
  30. $Text="";
  31. while (my ($key, $value) = each(%strong) ) {
  32.   my $s= join(",",sortuniq(split(' ', $value)));
  33.   $Text .= $key . ":" . $s . "\n" ;
  34. }
  35. out("strong_index",join("\n",sortuniq(split("\n",$Text))));
  36.  
  37. sub sortuniq {
  38.   my $prev = "not $_[0]";
  39.   grep { $_ ne $prev && ($prev = $_, 1) } sort @_;
  40. }
  41.  
  42. sub out { my ($bloc, $text) = @_;
  43.   open  (OUT, ">$bloc") ;
  44.   print OUT $text ; close OUT;
  45. }
  46.