Subversion Repositories wimsdev

Rev

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