Subversion Repositories wimsdev

Rev

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

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