Subversion Repositories wimsdev

Rev

Rev 7016 | Rev 11479 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 7016 Rev 9875
Line 12... Line 12...
12 
my $ref=\%ref;
 12 
my $ref=\%ref;
13 
my @list=listclass();
 13 
my @list=listclass();
14 
my $dirout="../class";
 14 
my $dirout="../class";
15 
$ref=refclass(@list);
 15 
$ref=refclass(@list);
16 
my @Key = ('supervisor','domain','level','lang','institution','description','addr','keywords','title', 'information');
 16 
my @Key = ('supervisor','domain','level','lang','institution','description','addr','keywords','title', 'information');
17 
my @Lang= ('fr','en','it','nl') ;
 17 
my @Lang= ('fr','en','it','nl');
18 
my %T = ('version' => 'version',
 18 
my %T = ('version' => 'version',
19 
'lang' => 'language',
 19 
'lang' => 'language',
20 
'description' => 'title',
 20 
'description' => 'title',
21 
'supervisor' => 'author',
 21 
'supervisor' => 'author',
22 
'institution' => 'description',
 22 
'institution' => 'description',
Line 26... Line 26...
26 
my %keywords=();
 26 
my %keywords=();
27 
 
 27 
 
28 
for my $key (@Key) {
 28 
for my $key (@Key) {
29 
  my $text='';
 29 
  my $text='';
30 
  for my $cl (@list) {
 30 
  for my $cl (@list) {
31 
    $text .=  "$cl:";
 31 
    $text .=  "$cl:";
32 
    $text .= $ref{$cl}{$key} if ($ref{$cl}{$key});
 32 
    $text .= $ref{$cl}{$key} if ($ref{$cl}{$key});
33 
    $text .= "\n";
 33 
    $text .= "\n";
34 
  };
 34 
  };
35 
  out("$dirout/$T{$key}",join("\n",sort( split("\n", $text)))) if ($T{$key}) ;
 35 
  out("$dirout/$T{$key}",join("\n",sort( split("\n", $text)))) if ($T{$key});
36 
}
 36 
}
37 
for my $l (@Lang) { my $text='';
 37 
for my $l (@Lang) { my $text='';
38 
  my %dom = treate_dict ("$dirdomain/domain.$l");
 38 
  my %dom = treate_dict ("$dirdomain/domain.$l");
39 
  my $dom = \%dom;
 39 
  my $dom = \%dom;
40 
  for my $cl (@list) {
 40 
  for my $cl (@list) {
41 
    next if (!($ref{$cl}{'lang'} =~ /$l/)) ;
 41 
    next if (!($ref{$cl}{'lang'} =~ /$l/));
42 
    next if (!$ref{$cl}{'keywords'});
 42 
    next if (!$ref{$cl}{'keywords'});
43 
    $ref{$cl}{'keywords'}=lc(treate_accent($ref{$cl}{'keywords'}));
 43 
    $ref{$cl}{'keywords'}=lc(treate_accent($ref{$cl}{'keywords'}));
44 
    for my $k (sortuniq(split(', *',$ref{$cl}{'keywords'}))) {
 44 
    for my $k (sortuniq(split(', *',$ref{$cl}{'keywords'}))) {
45 
      $k =treate_accent($k);
 45 
      $k =treate_accent($k);
46 
      if ($keywords{$k}) { $keywords{$k} .= " " . $cl  } else { $keywords{$k} = $cl};
 46 
      if ($keywords{$k}) { $keywords{$k} .= " " . $cl  } else { $keywords{$k} = $cl};
- 
 
 47 
      next if !($dom{$k});
- 
 
 48 
      my $d=lc(treate_accent($dom{$k}));
- 
 
 49 
      if ($keywords{$d}) { $keywords{$d} .= " " . $cl  } else { $keywords{$d} = $cl};
47 
    }
 50 
    }
48 
    for my $k (split(',',$ref{$cl}{'domain'})) {
 51 
    for my $k (split(',',$ref{$cl}{'domain'})) {
49 
      if ($keywords{$k}) { $keywords{$k} .= " " . $cl  } else { $keywords{$k} = $cl};
 52 
      if ($keywords{$k}) { $keywords{$k} .= " " . $cl  } else { $keywords{$k} = $cl};
50 
       next if !($dom{$k});
 53 
       next if !($dom{$k});
51 
       my $d=lc(treate_accent($dom{$k}));
 54 
       my $d=lc(treate_accent($dom{$k}));
52 
      if ($keywords{$d}) { $keywords{$d} .= " " . $cl  } else { $keywords{$d} = $cl};
 55 
      if ($keywords{$d}) { $keywords{$d} .= " " . $cl  } else { $keywords{$d} = $cl};
53 
  }
 56 
  }
54 
 }
 57 
 }
55 
   while ( my ($key, $value) = each (%keywords) ) {
 58 
   while ( my ($key, $value) = each (%keywords) ) {
56 
     my $v = join(" ", sortuniq(split(" ",$value)));
 59 
     my $v = join(" ", sortuniq(split(" ",$value)));
57 
     $text .= "$key:$v\n" ;
 60 
     $text .= "$key:$v\n";
58 
   }
 61 
   }
59 
   $text =~ s / +(\w+:)/ $1/g;
 62 
   $text =~ s / +(\w+:)/ $1/g;
60 
   out("$dirout/$l", join("\n", sortuniq(split("\n",$text))));
 63 
   out("$dirout/$l", join("\n", sortuniq(split("\n",$text))));
61 
}
 64 
}
62 
 
 65 
 
63 
###############################
 66 
###############################
64 
sub refclass { my @L=@_ ;
 67 
sub refclass { my @L=@_;
65 
  for my $cl (@L) {
 68 
  for my $cl (@L) {
66 
    open IN, "$dir/$cl/.def";
 69 
    open IN, "$dir/$cl/.def";
67 
    while(<IN>) {
 70 
    while(<IN>) {
68 
    if ($_ =~ /!set class_(\w+)=\s*(.*)/) {
 71 
    if ($_ =~ /!set class_(\w+)=\s*(.*)/) {
69 
    my $f = $1; my $r= $2 ;
 72 
    my $f = $1; my $r= $2;
70 
     if ($f =~ /\blevel/) {
 73 
     if ($f =~ /\blevel/) {
71 
        $r=~ s/ //g;
 74 
        $r=~ s/ //g;
72 
        if( $r) { $ref{$cl}{$f}= "level" . join(', level', split(',',$r)) ;}
 75 
        if( $r) { $ref{$cl}{$f}= "level" . join(', level', split(',',$r));}
73 
       }
 76 
       }
74 
       else { $ref{$cl}{$1}=$2 ;}}
 77 
       else { $ref{$cl}{$1}=$2;}}
75 
       }
 78 
       }
76 
    close IN;
 79 
    close IN;
77 
  }
 80 
  }
78 
}
 81 
}
79 
 
 82 
 
80 
sub listclass {
 83 
sub listclass {
81 
 my @L= () ;
 84 
 my @L= ();
82 
 for my $cl (glob("$dir/*")) {
 85 
 for my $cl (glob("$dir/*")) {
83 
   $cl=~s /$dir\/// ;
 86 
   $cl=~s /$dir\///;
84 
   push @L, $cl if (!($cl =~ /[A-Z]+/) && $cl < 10000) ;
 87 
   push @L, $cl if (!($cl =~ /[A-Z]+/) && $cl < 10000);
85 
  }
 88 
  }
86 
  @L
 89 
  @L
87 
}
 90 
}