Subversion Repositories wimsdev

Rev

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

Rev Author Line No. Line
12573 bpr 1
#!/usr/bin/perl
2
 
3
use warnings;
4
use strict;
5
my %ref;
6
my $ref=\%ref;
12665 bpr 7
my %strong;
8
my $strong=\%strong;
12573 bpr 9
my ($type, $add)=("","");
15361 bpr 10
my $glist="";
15403 bpr 11
my @list_sort=();
12
my $list_to_sort="";
12573 bpr 13
for my $file (glob("*/*/*/*")) {
14
  open(IN, $file) ;
15361 bpr 15
  $glist .= "$file\n" if !($file=~/_\d\b/) && !($file=~/\/macro\//);
12573 bpr 16
  while (<IN>) { my $line = $_;
12665 bpr 17
    if ($line=~ /<strong>([^<]+)<\/strong>/) { $strong{$1} .= " $file"};
18
    next if !($line =~ /gl_keywords=/ || $line =~ /gl_type=/) ;
19
    $type=$1 if($line=~/gl_type=(.*)/);
12573 bpr 20
    $add =$1 if($line=~/!set gl_keywords=(.*)/);
21
    chomp $add; chomp $type;
15403 bpr 22
    @list_sort=split('/', $file);
23
    $list_to_sort .= "$list_sort[0],$list_sort[1],$list_sort[3],$list_sort[2]\n";
12573 bpr 24
  }
25
  $type='main' if !($type);
26
  $ref{$add} .= "$file/$type " if ($add);
15403 bpr 27
  $type=""; $add="";
12573 bpr 28
};
15403 bpr 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
 
12644 bpr 39
my $Text="generated by mkindex.pl\n\n";
12573 bpr 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
 
12665 bpr 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))));
15361 bpr 52
out("glist",$glist);
12665 bpr 53
 
12573 bpr 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
}