Subversion Repositories wimsdev

Rev

Rev 15403 | 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)=("","");
15437 bpr 10
my $glist0="";
15361 bpr 11
my $glist="";
15403 bpr 12
my @list_sort=();
13
my $list_to_sort="";
12573 bpr 14
for my $file (glob("*/*/*/*")) {
15
  open(IN, $file) ;
15361 bpr 16
  $glist .= "$file\n" if !($file=~/_\d\b/) && !($file=~/\/macro\//);
12573 bpr 17
  while (<IN>) { my $line = $_;
12665 bpr 18
    if ($line=~ /<strong>([^<]+)<\/strong>/) { $strong{$1} .= " $file"};
19
    next if !($line =~ /gl_keywords=/ || $line =~ /gl_type=/) ;
20
    $type=$1 if($line=~/gl_type=(.*)/);
12573 bpr 21
    $add =$1 if($line=~/!set gl_keywords=(.*)/);
22
    chomp $add; chomp $type;
15403 bpr 23
    @list_sort=split('/', $file);
24
    $list_to_sort .= "$list_sort[0],$list_sort[1],$list_sort[3],$list_sort[2]\n";
12573 bpr 25
  }
26
  $type='main' if !($type);
27
  $ref{$add} .= "$file/$type " if ($add);
15403 bpr 28
  $type=""; $add="";
12573 bpr 29
};
15403 bpr 30
 
31
@list_sort=sortuniq(split("\n",join("\n", sortuniq(split("\n",$list_to_sort)))));
15437 bpr 32
$glist="";
15403 bpr 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
 
12644 bpr 40
my $Text="generated by mkindex.pl\n\n";
12573 bpr 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
 
12665 bpr 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))));
15361 bpr 53
out("glist",$glist);
12665 bpr 54
 
12573 bpr 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
}