Subversion Repositories wimsdev

Rev

Rev 11480 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 11480 Rev 16604
Line 15... Line 15...
15 
my $prelim="##This file is generated by classif.pl. Do not modify directly\n";
 15 
my $prelim="##This file is generated by classif.pl. Do not modify directly\n";
16 
sub  dicclassification { my ($dirout, @liste)=@_;
 16 
sub  dicclassification { my ($dirout, @liste)=@_;
17 
  my %ref=reverse_dic(@liste);
 17 
  my %ref=reverse_dic(@liste);
18 
  my $TEXT=$prelim;
 18 
  my $TEXT=$prelim;
19 
  for my $k (sort keys %ref) {
 19 
  for my $k (sort keys %ref) {
20 
   if ($ref{$k}) {
 20 
    if ($ref{$k}) {
21 
    $TEXT .= "$k:$ref{$k}\n";
 21 
      $TEXT .= "$k:$ref{$k}\n";
22 
   }
 22 
    }
23 
  out("$dirout", $TEXT);
 23 
    out("$dirout", $TEXT);
24 
  }
 24 
  }
25 
}
 25 
}
26 
 
 26 
 
27 
sub reverse_dic { my @liste=@_;
 27 
sub reverse_dic { my @liste=@_;
28 
  my %ref = ( ) ; my $ref=\%ref;
 28 
  my %ref = ( ) ; my $ref=\%ref;
29 
  for my $file (@liste) {
 29 
  for my $file (@liste) {
30 
   open IN, "$file";
 30 
    open IN, "$file";
31 
   while (<IN>) {
 31 
    while (<IN>) {
32 
    next if ($_ =~ /^#/);
 32 
      next if ($_ =~ /^#/);
33 
    my $text= $_ ; $text=~ s/\n//;
 33 
      my $text= $_ ; $text=~ s/\n//;
34 
    my @text=split(":", $text);
 34 
      my @text=split(":", $text);
35 
    next if !($text[1]);
 35 
      next if !($text[1]);
36 
    my $t=$text[0]; $t=~ s/\n//;
 36 
      my $t=$text[0]; $t=~ s/\n//;
37 
    my @L= split(",",$text[1]);
 37 
      my @L= split(",",$text[1]);
38 
    for my $a (@L) {
 38 
      for my $a (@L) {
39 
     if ($ref{$a}) {  $ref{$a}.= "," . $t ; }
 39 
       if ($ref{$a}) {  $ref{$a}.= "," . $t ; } else { $ref{$a} = $t ; }
40 
     else { $ref{$a} = $t ; }
 40 
      }
41 
    }
 41 
    }
42 
   }
 - 
 
43 
   close IN;
 42 
    close IN;
44 
  }
 43 
  }
45 
  %ref
 44 
  %ref
46 
}
 45 
}
47 
 
 46 
 
48 
sub out { my ($bloc, $text) = @_;
 47 
sub out { my ($bloc, $text) = @_;