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
}